From: Gaius Mulley Date: Sat, 4 Mar 2023 12:44:49 +0000 (+0000) Subject: Modula-2 rename autogenerated .c files to .cc X-Git-Tag: basepoints/gcc-14~728 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ab61100f4f00776e30bf92caac0d7b9963183cfd;p=thirdparty%2Fgcc.git Modula-2 rename autogenerated .c files to .cc This patch renames all the pge-boot/*.c files to .cc. It also renames the m2/mc-boot/*.c files to .cc. Finally it renames some of the mc-boot-ch hand built interface files to .cc. gcc/m2/ChangeLog: * Make-lang.in (MC-LIB-BOOT-C): Rename to MC-LIB-BOOT-CC. (MC-BOOT-C): Rename to MC-BOOT-CC. (BUILD-MC-BOOT-C): Rename to BUILD-MC-BOOT-CC. (BUILD-MC-BOOT-AUTO-C): Rename to BUILD-MC-BOOT-AUTO-CC. (m2/mc-boot/$(SRC_PREFIX)%.o): Change source file extension to .cc. (m2/mc-boot-ch/$(SRC_PREFIX)%.o): Ditto. * Make-maintainer.in (m2/gm2-ppg-boot/$(SRC_PREFIX)%.o): Change source file extension to .cc. (m2/gm2-ppg-boot/main.o): Ditto. (m2/gm2-ppg-boot/$(SRC_PREFIX)%.o): Ditto. to .cc. (m2/gm2-pg-boot/main.o): Ditto. (m2/gm2-pge-boot/$(SRC_PREFIX)ldtoa.o): Ditto. (m2/gm2-pge-boot/$(SRC_PREFIX)dtoa.o): Ditto. (m2/gm2-pge-boot/$(SRC_PREFIX)errno.o): Ditto. (m2/gm2-pge-boot/$(SRC_PREFIX)M2RTS.o): Ditto. (m2/gm2-pge-boot/$(SRC_PREFIX)%.o): Ditto. (m2/gm2-pge-boot/$(SRC_PREFIX)%.o): Ditto. (m2/gm2-pge-boot/$(SRC_PREFIX)pge.o): Ditto. (m2/gm2-pge-boot/main.o): Ditto. (mc-push): Ditto. (mc-clean): Ditto. (mc-stage2): Ditto. ((objdir)/m2/mc-boot-gen): Ditto. (m2/mc-boot-gen/$(SRC_PREFIX)decl.c): Ditto. (m2/mc-boot-gen/$(SRC_PREFIX)%.c): Ditto. * mc-boot-ch/GBuiltins.c: Correct comment and rename. * mc-boot-ch/Gdtoa.c: Correct comment and rename. * mc-boot-ch/Gldtoa.c: Correct comment and rename * mc-boot-ch/Gtermios.cc: Rename from Gtermios.c. * mc-boot-ch/Gerrno.c: Rename. * mc-boot-ch/GRTco.c: Removed. * mc-boot/GASCII.c: Rename to mc-boot/GASCII.cc. * mc-boot/GArgs.c: Rename to mc-boot/GArgs.cc. * mc-boot/GAssertion.c: Rename to mc-boot/GAssertion.cc. * mc-boot/GBreak.c: Rename to mc-boot/GBreak.cc. * mc-boot/GCmdArgs.c: Rename to mc-boot/GCmdArgs.cc. * mc-boot/GDebug.c: Rename to mc-boot/GDebug.cc. * mc-boot/GDynamicStrings.c: Rename to mc-boot/GDynamicStrings.cc. * mc-boot/GEnvironment.c: Rename to mc-boot/GEnvironment.cc. * mc-boot/GFIO.c: Rename to mc-boot/GFIO.cc. * mc-boot/GFormatStrings.c: Rename to mc-boot/GFormatStrings.cc. * mc-boot/GFpuIO.c: Rename to mc-boot/GFpuIO.cc. * mc-boot/GIO.c: Rename to mc-boot/GIO.cc. * mc-boot/GIndexing.c: Rename to mc-boot/GIndexing.cc. * mc-boot/GM2Dependent.c: Rename to mc-boot/GM2Dependent.cc. * mc-boot/GM2EXCEPTION.c: Rename to mc-boot/GM2EXCEPTION.cc. * mc-boot/GM2RTS.c: Rename to mc-boot/GM2RTS.cc. * mc-boot/GMemUtils.c: Rename to mc-boot/GMemUtils.cc. * mc-boot/GNumberIO.c: Rename to mc-boot/GNumberIO.cc. * mc-boot/GPushBackInput.c: Rename to mc-boot/GPushBackInput.cc. * mc-boot/GRTExceptions.c: Rename to mc-boot/GRTExceptions.cc. * mc-boot/GRTint.c: Rename to mc-boot/GRTint.cc. * mc-boot/GSArgs.c: Rename to mc-boot/GSArgs.cc. * mc-boot/GSFIO.c: Rename to mc-boot/GSFIO.cc. * mc-boot/GStdIO.c: Rename to mc-boot/GStdIO.cc. * mc-boot/GStorage.c: Rename to mc-boot/GStorage.cc. * mc-boot/GStrCase.c: Rename to mc-boot/GStrCase.cc. * mc-boot/GStrIO.c: Rename to mc-boot/GStrIO.cc. * mc-boot/GStrLib.c: Rename to mc-boot/GStrLib.cc. * mc-boot/GStringConvert.c: Rename to mc-boot/GStringConvert.cc. * mc-boot/GSysStorage.c: Rename to mc-boot/GSysStorage.cc. * mc-boot/GTimeString.c: Rename to mc-boot/GTimeString.cc. * mc-boot/Galists.c: Rename to mc-boot/Galists.cc. * mc-boot/Gdecl.c: Rename to mc-boot/Gdecl.cc. * mc-boot/Gkeyc.c: Rename to mc-boot/Gkeyc.cc. * mc-boot/Glists.c: Rename to mc-boot/Glists.cc. * mc-boot/GmcComment.c: Rename to mc-boot/GmcComment.cc. * mc-boot/GmcComp.c: Rename to mc-boot/GmcComp.cc. * mc-boot/GmcDebug.c: Rename to mc-boot/GmcDebug.cc. * mc-boot/GmcError.c: Rename to mc-boot/GmcError.cc. * mc-boot/GmcFileName.c: Rename to mc-boot/GmcFileName.cc. * mc-boot/GmcLexBuf.c: Rename to mc-boot/GmcLexBuf.cc. * mc-boot/GmcMetaError.c: Rename to mc-boot/GmcMetaError.cc. * mc-boot/GmcOptions.c: Rename to mc-boot/GmcOptions.cc. * mc-boot/GmcPreprocess.c: Rename to mc-boot/GmcPreprocess.cc. * mc-boot/GmcPretty.c: Rename to mc-boot/GmcPretty.cc. * mc-boot/GmcPrintf.c: Rename to mc-boot/GmcPrintf.cc. * mc-boot/GmcQuiet.c: Rename to mc-boot/GmcQuiet.cc. * mc-boot/GmcReserved.c: Rename to mc-boot/GmcReserved.cc. * mc-boot/GmcSearch.c: Rename to mc-boot/GmcSearch.cc. * mc-boot/GmcStack.c: Rename to mc-boot/GmcStack.cc. * mc-boot/GmcStream.c: Rename to mc-boot/GmcStream.cc. * mc-boot/Gmcp1.c: Rename to mc-boot/Gmcp1.cc. * mc-boot/Gmcp2.c: Rename to mc-boot/Gmcp2.cc. * mc-boot/Gmcp3.c: Rename to mc-boot/Gmcp3.cc. * mc-boot/Gmcp4.c: Rename to mc-boot/Gmcp4.cc. * mc-boot/Gmcp5.c: Rename to mc-boot/Gmcp5.cc. * mc-boot/GnameKey.c: Rename to mc-boot/GnameKey.cc. * mc-boot/GsymbolKey.c: Rename to mc-boot/GsymbolKey.cc. * mc-boot/Gtop.c: Rename to mc-boot/Gtop.cc. * mc-boot/Gvarargs.c: Rename to mc-boot/Gvarargs.cc. * mc-boot/Gwlists.c: Rename to mc-boot/Gwlists.cc. * pge-boot/GASCII.c: Rename to pge-boot/GASCII.cc. * pge-boot/GArgs.c: Rename to pge-boot/GArgs.cc. * pge-boot/GAssertion.c: Rename to pge-boot/GAssertion.cc. * pge-boot/GBuiltins.c: Rename to pge-boot/GBuiltins.cc. * pge-boot/GDebug.c: Rename to pge-boot/GDebug.cc. * pge-boot/GDynamicStrings.c: Rename to pge-boot/GDynamicStrings.cc. * pge-boot/GFIO.c: Rename to pge-boot/GFIO.cc. * pge-boot/GIO.c: Rename to pge-boot/GIO.cc. * pge-boot/GIndexing.c: Rename to pge-boot/GIndexing.cc. * pge-boot/GLists.c: Rename to pge-boot/GLists.cc. * pge-boot/GM2Dependent.c: Rename to pge-boot/GM2Dependent.cc. * pge-boot/GM2EXCEPTION.c: Rename to pge-boot/GM2EXCEPTION.cc. * pge-boot/GM2LINK.c: Rename to pge-boot/GM2LINK.cc. * pge-boot/GM2RTS.c: Rename to pge-boot/GM2RTS.cc. * pge-boot/GNameKey.c: Rename to pge-boot/GNameKey.cc. * pge-boot/GNumberIO.c: Rename to pge-boot/GNumberIO.cc. * pge-boot/GOutput.c: Rename to pge-boot/GOutput.cc. * pge-boot/GPushBackInput.c: Rename to pge-boot/GPushBackInput.cc. * pge-boot/GRTExceptions.c: Rename to pge-boot/GRTExceptions.cc. * pge-boot/GRTco.c: Rename to pge-boot/GRTco.cc. * pge-boot/GSFIO.c: Rename to pge-boot/GSFIO.cc. * pge-boot/GSYSTEM.c: Rename to pge-boot/GSYSTEM.cc. * pge-boot/GSelective.c: Rename to pge-boot/GSelective.cc. * pge-boot/GStdIO.c: Rename to pge-boot/GStdIO.cc. * pge-boot/GStorage.c: Rename to pge-boot/GStorage.cc. * pge-boot/GStrCase.c: Rename to pge-boot/GStrCase.cc. * pge-boot/GStrIO.c: Rename to pge-boot/GStrIO.cc. * pge-boot/GStrLib.c: Rename to pge-boot/GStrLib.cc. * pge-boot/GSymbolKey.c: Rename to pge-boot/GSymbolKey.cc. * pge-boot/GSysExceptions.c: Rename to pge-boot/GSysExceptions.cc. * pge-boot/GSysStorage.c: Rename to pge-boot/GSysStorage.cc. * pge-boot/Gabort.c: Rename to pge-boot/Gabort.cc. * pge-boot/Gbnflex.c: Rename to pge-boot/Gbnflex.cc. * pge-boot/Gcbuiltin.c: Rename to pge-boot/Gcbuiltin.cc. * pge-boot/Gdtoa.c: Rename to pge-boot/Gdtoa.cc. * pge-boot/Gerrno.c: Rename to pge-boot/Gerrno.cc. * pge-boot/Gldtoa.c: Rename to pge-boot/Gldtoa.cc. * pge-boot/Glibc.c: Rename to pge-boot/Glibc.cc. * pge-boot/Glibm.c: Rename to pge-boot/Glibm.cc. * pge-boot/Gmcrts.c: Rename to pge-boot/Gmcrts.cc. * pge-boot/Gpge.c: Rename to pge-boot/Gpge.cc. * pge-boot/Gwrapc.c: Rename to pge-boot/Gwrapc.cc. * pge-boot/README: Correct description. * pge-boot/main.c: Rename to pge-boot/main.cc. * pge-boot/network.c: Rename to pge-boot/network.cc. Signed-off-by: Gaius Mulley --- diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in index 644dcf26772b..a8d99c4fc8d6 100644 --- a/gcc/m2/Make-lang.in +++ b/gcc/m2/Make-lang.in @@ -1224,7 +1224,7 @@ MC-LIB-MODS = \ SysStorage.mod \ TimeString.mod \ -MC-LIB-BOOT-C = $(MC-LIB-MODS:%.mod=%.c) +MC-LIB-BOOT-CC = $(MC-LIB-MODS:%.mod=%.cc) # Definition modules for the modula-2 to C++ translator found in mc. @@ -1300,7 +1300,7 @@ MC-AUTO-MODS = \ mcp4.mod \ mcp5.mod -MC-BOOT-C = $(MC-MODS:%.mod=%.c) $(MC-AUTO-MODS:%.mod=%.c) +MC-BOOT-CC = $(MC-MODS:%.mod=%.cc) $(MC-AUTO-MODS:%.mod=%.cc) # C interface files for mc. @@ -1326,13 +1326,13 @@ MC-INTERFACE-CC = \ BUILD-MC-BOOT-H = $(MC-LIB-DEFS:%.def=m2/mc-boot-gen/$(SRC_PREFIX)%.h) \ $(MC-DEFS:%.def=m2/mc-boot-gen/$(SRC_PREFIX)%.h) -BUILD-MC-BOOT-C = $(MC-LIB-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c) \ - $(MC-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c) +BUILD-MC-BOOT-CC = $(MC-LIB-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.cc) \ + $(MC-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.cc) -BUILD-MC-BOOT-AUTO-C = $(MC-AUTO-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c) +BUILD-MC-BOOT-AUTO-CC = $(MC-AUTO-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.cc) -BUILD-MC-BOOT-O = $(MC-LIB-BOOT-C:%.c=m2/mc-boot/$(SRC_PREFIX)%.o) \ - $(MC-BOOT-C:%.c=m2/mc-boot/$(SRC_PREFIX)%.o) +BUILD-MC-BOOT-O = $(MC-LIB-BOOT-CC:%.cc=m2/mc-boot/$(SRC_PREFIX)%.o) \ + $(MC-BOOT-CC:%.cc=m2/mc-boot/$(SRC_PREFIX)%.o) BUILD-MC-INTERFACE-O = $(MC-INTERFACE-C:%.c=m2/mc-boot-ch/$(SRC_PREFIX)%.o) \ $(MC-INTERFACE-CC:%.cc=m2/mc-boot-ch/$(SRC_PREFIX)%.o) @@ -1350,7 +1350,7 @@ m2/boot-bin/mc$(exeext): $(BUILD-MC-BOOT-O) $(BUILD-MC-INTERFACE-O) \ $(BUILD-MC-INTERFACE-O) m2/mc-boot/main.o \ mcflex.o m2/gm2-libs-boot/RTcodummy.o -lm -m2/mc-boot/$(SRC_PREFIX)%.o: m2/mc-boot/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h +m2/mc-boot/$(SRC_PREFIX)%.o: m2/mc-boot/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h -test -d $(@D) || $(mkinstalldirs) $(@D) $(CXX) -g -c -I. -I$(srcdir)/m2/mc-boot-ch -I$(srcdir)/m2/mc-boot -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) $< -o $@ @@ -1364,8 +1364,8 @@ m2/mc-boot-ch/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2- m2/mc-boot/main.o: $(M2LINK) $(srcdir)/m2/init/mcinit -test -d $(@D) || $(mkinstalldirs) $(@D) - unset CC ; $(M2LINK) -s --langc++ --exit --name m2/mc-boot/main.c $(srcdir)/m2/init/mcinit - $(CXX) -g -c -I. -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) m2/mc-boot/main.c -o $@ + unset CC ; $(M2LINK) -s --langc++ --exit --name m2/mc-boot/main.cc $(srcdir)/m2/init/mcinit + $(CXX) -g -c -I. -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) m2/mc-boot/main.cc -o $@ mcflex.o: mcflex.c m2/gm2-libs/gm2-libs-host.h $(CC) -I$(srcdir)/m2/mc -g -c $< -o $@ # remember that mcReserved.h is copied into m2/mc diff --git a/gcc/m2/Make-maintainer.in b/gcc/m2/Make-maintainer.in index 81f5abea59c0..184c51281993 100644 --- a/gcc/m2/Make-maintainer.in +++ b/gcc/m2/Make-maintainer.in @@ -113,24 +113,24 @@ m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm m2/gm2-ppg-boot/$(SRC_PREFIX)M2RTS.o: $(srcdir)/m2/gm2-libs/M2RTS.mod $(MCDEPS) $(BUILD-BOOT-PPG-H) -test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot - $(MCC) --suppress-noreturn -o=m2/gm2-ppg-boot/$(SRC_PREFIX)M2RTS.c $(srcdir)/m2/gm2-libs/M2RTS.mod + $(MCC) --suppress-noreturn -o=m2/gm2-ppg-boot/$(SRC_PREFIX)M2RTS.cc $(srcdir)/m2/gm2-libs/M2RTS.mod $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \ -Im2/gm2-ppg-boot -I$(srcdir)/m2/mc-boot -Im2/gm2-libs-boot \ - -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)M2RTS.c -o $@ + -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)M2RTS.cc -o $@ m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-PPG-H) -test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot - $(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod + $(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.cc $(srcdir)/m2/gm2-libs/$*.mod $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \ -Im2/gm2-ppg-boot -I$(srcdir)/m2/mc-boot -Im2/gm2-libs-boot \ - -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c -o $@ + -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)$*.cc -o $@ m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-PPG-H) -test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot - $(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-compiler/$*.mod + $(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.cc $(srcdir)/m2/gm2-compiler/$*.mod $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \ -Im2/mc-boot -Im2/gm2-compiler-boot -Im2/gm2-libs-boot \ - -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c -o $@ + -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)$*.cc -o $@ m2/ppg$(exeext): m2/boot-bin/mc $(BUILD-PPG-O) $(BUILD-MC-INTERFACE-O) m2/gm2-ppg-boot/main.o \ m2/gm2-libs-boot/RTcodummy.o m2/mc-boot-ch/$(SRC_PREFIX)abort.o \ @@ -142,9 +142,9 @@ m2/ppg$(exeext): m2/boot-bin/mc $(BUILD-PPG-O) $(BUILD-MC-INTERFACE-O) m2/gm2-pp m2/gm2-ppg-boot/main.o: $(M2LINK) $(srcdir)/m2/init/mcinit -test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot - unset CC ; $(M2LINK) -s --langc++ --exit --name mainppginit.c $(srcdir)/m2/init/ppginit - mv mainppginit.c m2/gm2-ppg-boot/main.c - $(CXX) $(INCLUDES) -g -c -o $@ m2/gm2-ppg-boot/main.c + unset CC ; $(M2LINK) -s --langc++ --exit --name mainppginit.cc $(srcdir)/m2/init/ppginit + mv mainppginit.cc m2/gm2-ppg-boot/main.cc + $(CXX) $(INCLUDES) -g -c -o $@ m2/gm2-ppg-boot/main.cc m2/gm2-auto: -test -d $@ || $(mkinstalldirs) $@ @@ -265,9 +265,9 @@ m2/gm2-auto/pginit: m2/gm2-pg-boot/main.o: m2/gm2-auto/pginit $(M2LINK) -test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot - unset CC ; $(M2LINK) -s --langc++ --exit --name mainpginit.c m2/gm2-auto/pginit - mv mainpginit.c m2/gm2-pg-boot/main.c - $(CXX) $(INCLUDES) -g -c -o $@ m2/gm2-pg-boot/main.c + unset CC ; $(M2LINK) -s --langc++ --exit --name mainpginit.cc m2/gm2-auto/pginit + mv mainpginit.cc m2/gm2-pg-boot/main.cc + $(CXX) $(INCLUDES) -g -c -o $@ m2/gm2-pg-boot/main.cc m2/pg-e$(exeext): m2/pg$(exeext) -test -d m2 || $(mkinstalldirs) m2 @@ -331,11 +331,11 @@ m2/gm2-pge-boot/$(SRC_PREFIX)SysExceptions.o: $(srcdir)/m2/mc-boot-ch/GSysExcep -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@ -m2/gm2-pge-boot/$(SRC_PREFIX)ldtoa.o: $(srcdir)/m2/mc-boot-ch/Gldtoa.c m2/gm2-libs/gm2-libs-host.h +m2/gm2-pge-boot/$(SRC_PREFIX)ldtoa.o: $(srcdir)/m2/mc-boot-ch/Gldtoa.cc m2/gm2-libs/gm2-libs-host.h -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@ -m2/gm2-pge-boot/$(SRC_PREFIX)dtoa.o: $(srcdir)/m2/mc-boot-ch/Gdtoa.c m2/gm2-libs/gm2-libs-host.h +m2/gm2-pge-boot/$(SRC_PREFIX)dtoa.o: $(srcdir)/m2/mc-boot-ch/Gdtoa.cc m2/gm2-libs/gm2-libs-host.h -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@ @@ -347,37 +347,37 @@ m2/gm2-pge-boot/$(SRC_PREFIX)SYSTEM.o: $(srcdir)/m2/mc-boot-ch/GSYSTEM.c $(BUIL -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c $< -o $@ -m2/gm2-pge-boot/$(SRC_PREFIX)errno.o: $(srcdir)/m2/mc-boot-ch/Gerrno.c +m2/gm2-pge-boot/$(SRC_PREFIX)errno.o: $(srcdir)/m2/mc-boot-ch/Gerrno.cc -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c $< -o $@ m2/gm2-pge-boot/$(SRC_PREFIX)M2RTS.o: $(srcdir)/m2/gm2-libs/M2RTS.mod $(MCDEPS) $(BUILD-BOOT-PGE-H) -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot - $(MCC) --suppress-noreturn -o=m2/gm2-pge-boot/$(SRC_PREFIX)M2RTS.c $(srcdir)/m2/gm2-libs/M2RTS.mod + $(MCC) --suppress-noreturn -o=m2/gm2-pge-boot/$(SRC_PREFIX)M2RTS.cc $(srcdir)/m2/gm2-libs/M2RTS.mod $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/gm2-pge-boot -I$(srcdir)/m2/mc-boot \ -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs-boot \ - $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)M2RTS.c -o $@ + $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)M2RTS.cc -o $@ m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-PGE-H) -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot - $(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod + $(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.cc $(srcdir)/m2/gm2-libs/$*.mod $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/gm2-pge-boot -I$(srcdir)/m2/mc-boot \ -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs-boot \ - $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)$*.c -o $@ + $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)$*.cc -o $@ m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-PGE-H) -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot - $(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-compiler/$*.mod + $(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.cc $(srcdir)/m2/gm2-compiler/$*.mod $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot -Im2/gm2-compiler-boot \ -Im2/gm2-libs-boot \ - -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)$*.c -o $@ + -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)$*.cc -o $@ m2/gm2-pge-boot/$(SRC_PREFIX)pge.o: m2/gm2-auto/pge.mod $(MCDEPS) $(BUILD-BOOT-PGE-H) -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot - $(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)pge.c m2/gm2-auto/pge.mod + $(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)pge.cc m2/gm2-auto/pge.mod $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \ -I$(srcdir)/m2/mc-boot -Im2/gm2-compiler-boot -Im2/gm2-libs-boot \ - -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)pge.c -o $@ + -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)pge.cc -o $@ m2/pge$(exeext): m2/boot-bin/mc \ $(BUILD-PGE-O) $(GM2-PPG-MODS:%.mod=m2/gm2-pge-boot/%.o) \ @@ -403,9 +403,9 @@ m2/gm2-auto/pgeinit: m2/gm2-pge-boot/main.o: m2/gm2-auto/pgeinit $(M2LINK) -test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot - unset CC ; $(M2LINK) -s --langc++ --exit --name mainpgeinit.c m2/gm2-auto/pgeinit - mv mainpgeinit.c m2/gm2-pge-boot/main.c - $(CXX) $(INCLUDES) -g -c -o $@ m2/gm2-pge-boot/main.c + unset CC ; $(M2LINK) -s --langc++ --exit --name mainpgeinit.cc m2/gm2-auto/pgeinit + mv mainpgeinit.cc m2/gm2-pge-boot/main.cc + $(CXX) $(INCLUDES) -g -c -o $@ m2/gm2-pge-boot/main.cc $(objdir)/m2/gm2-ppg-boot: -test -d $@ || $(mkinstalldirs) $@ @@ -459,7 +459,7 @@ pge-libs-push: force done pge-app-push: force - cp m2/gm2-pge-boot/*.c $(srcdir)/m2/pge-boot + cp m2/gm2-pge-boot/*.c* $(srcdir)/m2/pge-boot # Perform sanity checks. @@ -496,11 +496,11 @@ GM2PATH=-I$(srcdir)/m2/mc \ mc: mc-clean mc-devel mc-push: force - cp -p m2/mc-boot-gen/*.c $(srcdir)/m2/mc-boot/ + cp -p m2/mc-boot-gen/*.cc $(srcdir)/m2/mc-boot/ cp -p m2/mc-boot-gen/*.h $(srcdir)/m2/mc-boot/ mc-clean: force m2/mc-obj - $(RM) m2/mc-boot-gen/*.[ch] m2/boot-bin/* m2/mc-boot/* m2/mc-boot-ch/* + $(RM) m2/mc-boot-gen/*.{cc,h} m2/boot-bin/* m2/mc-boot/* m2/mc-boot-ch/* mc-maintainer: mc-clean mc-autogen mc-push mc-clean mc-bootstrap @@ -527,26 +527,26 @@ mc-verify: mc-clean mc-bootstrap mc @echo "verifying the two generations of mc" for i in $(GM2-VERIFY-MODS) ; do \ echo -n "$$i " ; \ - m2/boot-bin/mc $(MC_ARGS) -o=mcout.c $(srcdir)/m2/gm2-compiler/$$i > /dev/null ; \ + m2/boot-bin/mc $(MC_ARGS) -o=mcout.cc $(srcdir)/m2/gm2-compiler/$$i > /dev/null ; \ echo -n "[1]" ; \ m2/boot-bin/mc.m2 $(MC_ARGS) -o=mcout.m2 $(srcdir)/m2/gm2-compiler/$$i > /dev/null ; \ echo -n "[2]" ; \ $(RM) $$i.mc-diff ; \ - if [ -f mcout.c -a -f mcout.m2 ] ; then \ - if diff mcout.c mcout.m2 > /dev/null ; then \ + if [ -f mcout.cc -a -f mcout.m2 ] ; then \ + if diff mcout.cc mcout.m2 > /dev/null ; then \ echo "[passed]" ; \ else \ echo "[*** failed ***]" ; \ - diff mcout.c mcout.m2 > $$i.mc-diff ; \ + diff mcout.cc mcout.m2 > $$i.mc-diff ; \ fi \ fi ; \ - $(RM) mcout.c mcout.m2 ; \ + $(RM) mcout.cc mcout.m2 ; \ done mc-stage2: force - m2/boot-bin/mc$(exeext) -I$(srcdir)/m2/mc:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=m2/mc-boot-gen/GmcStream.c $(srcdir)/m2/mc/mcStream.mod - m2/boot-bin/mc$(exeext) -I$(srcdir)/m2/mc:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=m2/mc-boot-gen/Gdecl.c $(srcdir)/m2/mc/decl.mod - if diff m2/mc-boot-gen/Gdecl.c $(srcdir)/m2/mc-boot/Gdecl.c ; then echo "passed" ; else echo "failed" ; fi + m2/boot-bin/mc$(exeext) -I$(srcdir)/m2/mc:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=m2/mc-boot-gen/GmcStream.cc $(srcdir)/m2/mc/mcStream.mod + m2/boot-bin/mc$(exeext) -I$(srcdir)/m2/mc:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=m2/mc-boot-gen/Gdecl.cc $(srcdir)/m2/mc/decl.mod + if diff m2/mc-boot-gen/Gdecl.cc $(srcdir)/m2/mc-boot/Gdecl.cc ; then echo "passed" ; else echo "failed" ; fi @@ -637,15 +637,15 @@ $(objdir)/m2/mc-boot-gen: -test -d $@ || $(mkinstalldirs) $@ mc-autogen: mc-clean mc-devel \ - $(BUILD-MC-BOOT-H) $(BUILD-MC-BOOT-C) \ - $(BUILD-MC-BOOT-AUTO-C) - for i in m2/mc-boot-gen/*.c ; do \ - echo $(CXX) -g -c -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/mc-boot-gen/ $$i -o m2/mc-boot-gen/`basename $$i .c`.o ; \ - $(CXX) -g -c -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/mc-boot-gen/ $$i -o m2/mc-boot-gen/`basename $$i .c`.o ; done + $(BUILD-MC-BOOT-H) $(BUILD-MC-BOOT-CC) \ + $(BUILD-MC-BOOT-AUTO-CC) + for i in m2/mc-boot-gen/*.cc ; do \ + echo $(CXX) -g -c -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/mc-boot-gen/ $$i -o m2/mc-boot-gen/`basename $$i .cc`.o ; \ + $(CXX) -g -c -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/mc-boot-gen/ $$i -o m2/mc-boot-gen/`basename $$i .cc`.o ; done @echo -n "built " @cd m2/mc-boot-gen ; ls *.o | wc -l @echo -n "out of " - @cd m2/mc-boot-gen ; ls *.c | wc -l + @cd m2/mc-boot-gen ; ls *.cc | wc -l @echo "modules" # EXTENDED_OPAQUE = --extended-opaque @@ -664,19 +664,19 @@ m2/mc-boot-gen/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def -test -d m2/mc-boot-gen || $(mkinstalldirs) m2/mc-boot-gen ./mc $(MC_OPTIONS) -I$(srcdir)/m2/mc -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=$@ $< -m2/mc-boot-gen/$(SRC_PREFIX)decl.c: $(srcdir)/m2/mc/decl.mod +m2/mc-boot-gen/$(SRC_PREFIX)decl.cc: $(srcdir)/m2/mc/decl.mod -test -d m2/mc-boot-gen || $(mkinstalldirs) m2/mc-boot-gen ./mc $(MC_OPTIONS) --extended-opaque -I$(srcdir)/m2/mc -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso --h-file-prefix=$(SRC_PREFIX) -o=$@ $< -m2/mc-boot-gen/$(SRC_PREFIX)%.c: $(srcdir)/m2/mc/%.mod +m2/mc-boot-gen/$(SRC_PREFIX)%.cc: $(srcdir)/m2/mc/%.mod -test -d m2/mc-boot-gen || $(mkinstalldirs) m2/mc-boot-gen ./mc $(MC_OPTIONS) -I$(srcdir)/m2/mc -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=$@ $< -m2/mc-boot-gen/$(SRC_PREFIX)%.c: $(srcdir)/m2/gm2-libs/%.mod +m2/mc-boot-gen/$(SRC_PREFIX)%.cc: $(srcdir)/m2/gm2-libs/%.mod -test -d m2/mc-boot-gen || $(mkinstalldirs) m2/mc-boot-gen ./mc $(MC_OPTIONS) -I$(srcdir)/m2/mc -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=$@ $< -m2/mc-boot-gen/$(SRC_PREFIX)%.c: $(srcdir)/m2/gm2-libs-iso/%.mod +m2/mc-boot-gen/$(SRC_PREFIX)%.cc: $(srcdir)/m2/gm2-libs-iso/%.mod -test -d m2/mc-boot-gen || $(mkinstalldirs) m2/mc-boot-gen ./mc $(MC_OPTIONS) -I$(srcdir)/m2/mc -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=$@ $< @@ -684,7 +684,7 @@ m2/mc-boot-gen/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs-iso/%.def -test -d m2/mc-boot-gen || $(mkinstalldirs) m2/mc-boot-gen ./mc $(MC_OPTIONS) -I$(srcdir)/m2/mc -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=$@ $< -m2/mc-boot-gen/$(SRC_PREFIX)%.c: m2/mc-obj/%.mod +m2/mc-boot-gen/$(SRC_PREFIX)%.cc: m2/mc-obj/%.mod -test -d m2/mc-boot-gen || $(mkinstalldirs) m2/mc-boot-gen ./mc $(MC_OPTIONS) -I$(srcdir)/m2/mc -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=$@ $< diff --git a/gcc/m2/mc-boot-ch/GBuiltins.c b/gcc/m2/mc-boot-ch/GBuiltins.c deleted file mode 100644 index 28a41c0427ad..000000000000 --- a/gcc/m2/mc-boot-ch/GBuiltins.c +++ /dev/null @@ -1,43 +0,0 @@ -/* GBuiltins.c dummy module to aid linking mc projects. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#if defined(__cplusplus) -#define EXTERN extern "C" -#else -#define EXTERN -#endif - - -/* init module constructor. */ - -EXTERN -void -_M2_Builtins_init (void) -{ -} - -/* finish module deconstructor. */ - -EXTERN -void -_M2_Builtins_fini (void) -{ -} diff --git a/gcc/m2/mc-boot-ch/GRTco.c b/gcc/m2/mc-boot-ch/GRTco.c deleted file mode 100644 index cb6f5152f5ad..000000000000 --- a/gcc/m2/mc-boot-ch/GRTco.c +++ /dev/null @@ -1,127 +0,0 @@ -/* RTco.c provides dummy access to thread primitives. - -Copyright (C) 2019-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#if defined(__cplusplus) -#define EXTERN extern "C" -#else -#define EXTERN -#endif - -EXTERN -void -RTco_wait (__attribute__ ((unused)) int sid) -{ -} - - -EXTERN -void -RTco_signal (__attribute__ ((unused)) int sid) -{ -} - - -EXTERN -int -RTco_init (void) -{ - return 0; -} - - -EXTERN -int -RTco_initSemaphore (__attribute__ ((unused)) int value) -{ - return 0; -} - - -/* signalThread signal the semaphore associated with thread tid. */ - -EXTERN -void -RTco_signalThread (__attribute__ ((unused)) int tid) -{ -} - - -/* waitThread wait on the semaphore associated with thread tid. */ - -EXTERN -void -RTco_waitThread (__attribute__ ((unused)) int tid) -{ -} - - -EXTERN -int -RTco_currentThread (void) -{ - return 0; -} - - -EXTERN -int -RTco_initThread (__attribute__ ((unused)) void (*proc)(void), - __attribute__ ((unused)) unsigned int stackSize) -{ - return 0; -} - - -EXTERN -void -RTco_transfer (__attribute__ ((unused)) int *p1, __attribute__ ((unused)) int p2) -{ -} - - -EXTERN -int -RTco_select (__attribute__ ((unused)) int p1, - __attribute__ ((unused)) void *p2, - __attribute__ ((unused)) void *p3, - __attribute__ ((unused)) void *p4, - __attribute__ ((unused)) void *p5) -{ - return 0; -} - - -EXTERN -void -_M2_RTco_init (void) -{ -} - -EXTERN -void -_M2_RTco_fini (void) -{ -} diff --git a/gcc/m2/mc-boot-ch/Gdtoa.c b/gcc/m2/mc-boot-ch/Gdtoa.c deleted file mode 100644 index 77a7ae50e020..000000000000 --- a/gcc/m2/mc-boot-ch/Gdtoa.c +++ /dev/null @@ -1,184 +0,0 @@ -/* Gdtoa.c provides access to double string conversion. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#define GM2 - -#include "config.h" -#include "system.h" - - -#ifdef __cplusplus -extern "C" { -#endif - -#define MAX_FP_DIGITS 500 - -typedef enum Mode { maxsignicant, decimaldigits } Mode; - -/* maxsignicant: return a string containing max(1,ndigits) - significant digits. The return string contains the string - produced by ecvt. decimaldigits: return a string produced by - fcvt. The string will contain ndigits past the decimal point - (ndigits may be negative). */ - -double -dtoa_strtod (const char *s, int *error) -{ - char *endp; - double d; - - errno = 0; - d = strtod (s, &endp); - if (endp != NULL && (*endp == '\0')) - *error = (errno != 0); - else - *error = TRUE; - return d; -} - -/* dtoa_calcmaxsig - calculates the position of the decimal point it - also removes the decimal point and exponent from string, p. */ - -int -dtoa_calcmaxsig (char *p, int ndigits) -{ - char *e; - char *o; - int x; - - e = index (p, 'E'); - if (e == NULL) - x = 0; - else - { - *e = (char)0; - x = atoi (e + 1); - } - - o = index (p, '.'); - if (o == NULL) - return strlen (p) + x; - else - { - memmove (o, o + 1, ndigits - (o - p)); - return o - p + x; - } -} - -/* dtoa_calcdecimal - calculates the position of the decimal point it - also removes the decimal point and exponent from string, p. It - truncates the digits in p accordingly to ndigits. Ie ndigits is - the number of digits after the '.' */ - -int -dtoa_calcdecimal (char *p, int str_size, int ndigits) -{ - char *e; - char *o; - int x; - int l; - - e = index (p, 'E'); - if (e == NULL) - x = 0; - else - { - *e = (char)0; - x = atoi (e + 1); - } - - l = strlen (p); - o = index (p, '.'); - if (o == NULL) - x += strlen (p); - else - { - int m = strlen (o); - memmove (o, o + 1, l - (o - p)); - if (m > 0) - o[m - 1] = '0'; - x += o - p; - } - if ((x + ndigits >= 0) && (x + ndigits < str_size)) - p[x + ndigits] = (char)0; - return x; -} - - -int -dtoa_calcsign (char *p, int str_size) -{ - if (p[0] == '-') - { - memmove (p, p + 1, str_size - 1); - return TRUE; - } - else - return FALSE; -} - - -char * -dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign) -{ - char format[50]; - char *p; - int r; - switch (mode) - { - - case maxsignicant: - ndigits += 20; /* enough for exponent. */ - p = (char *) malloc (ndigits); - snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E"); - snprintf (p, ndigits, format, d); - *sign = dtoa_calcsign (p, ndigits); - *decpt = dtoa_calcmaxsig (p, ndigits); - return p; - case decimaldigits: - p = (char *) malloc (MAX_FP_DIGITS + 20); - snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E"); - snprintf (p, MAX_FP_DIGITS + 20, format, d); - *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20); - *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits); - return p; - default: - abort (); - } -} - -#if defined(GM2) -/* GNU Modula-2 hooks */ - -void -_M2_dtoa_init (void) -{ -} - -void -_M2_dtoa_fini (void) -{ -} -#endif - -#ifdef __cplusplus -} -#endif diff --git a/gcc/m2/mc-boot-ch/Gerrno.c b/gcc/m2/mc-boot-ch/Gerrno.c deleted file mode 100644 index c65c48630afc..000000000000 --- a/gcc/m2/mc-boot-ch/Gerrno.c +++ /dev/null @@ -1,54 +0,0 @@ -/* Gerrno.c provides access to errno for Modula-2. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -#include "ansidecl.h" - -# ifdef __cplusplus -extern "C" { -# endif - -/* geterrno returns errno. */ - -int -errno_geterrno (void) -{ - return errno; -} - -/* init constructor for the module. */ - -void -_M2_errno_init (int argc, char *p) -{ -} - -/* finish deconstructor for the module. */ - -void -_M2_errno_fini (int argc, char *p) -{ -} - -# ifdef __cplusplus -} -# endif diff --git a/gcc/m2/mc-boot-ch/Gldtoa.c b/gcc/m2/mc-boot-ch/Gldtoa.c deleted file mode 100644 index a918cfc2d67b..000000000000 --- a/gcc/m2/mc-boot-ch/Gldtoa.c +++ /dev/null @@ -1,107 +0,0 @@ -/* Gldtoa.c provides access to long double string conversion. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" - -#include "gm2-libs-host.h" - -#ifdef __cplusplus -extern "C" { -#endif - -#define MAX_FP_DIGITS 500 - -typedef enum Mode { maxsignicant, decimaldigits } Mode; - -extern int dtoa_calcmaxsig (char *p, int ndigits); -extern int dtoa_calcdecimal (char *p, int str_size, int ndigits); -extern int dtoa_calcsign (char *p, int str_size); - -/* maxsignicant: return a string containing max(1,ndigits) - significant digits. The return string contains the string - produced by snprintf. decimaldigits: return a string produced by - fcvt. The string will contain ndigits past the decimal point - (ndigits may be negative). */ - -long double -ldtoa_strtold (const char *s, int *error) -{ - char *endp; - long double d; - - errno = 0; -#if defined(HAVE_STRTOLD) - d = strtold (s, &endp); -#else - /* fall back to using strtod. */ - d = (long double)strtod (s, &endp); -#endif - if (endp != NULL && (*endp == '\0')) - *error = (errno != 0); - else - *error = TRUE; - return d; -} - -char * -ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign) -{ - char format[50]; - char *p; - int r; - switch (mode) - { - - case maxsignicant: - ndigits += 20; /* enough for exponent. */ - p = (char *)malloc (ndigits); - snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE"); - snprintf (p, ndigits, format, d); - *sign = dtoa_calcsign (p, ndigits); - *decpt = dtoa_calcmaxsig (p, ndigits); - return p; - case decimaldigits: - p = (char *)malloc (MAX_FP_DIGITS + 20); - snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE"); - snprintf (p, MAX_FP_DIGITS + 20, format, d); - *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20); - *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits); - return p; - default: - abort (); - } -} - -/* GNU Modula-2 hooks */ - -void -_M2_ldtoa_init (void) -{ -} - -void -_M2_ldtoa_fini (void) -{ -} -# ifdef __cplusplus -} -# endif diff --git a/gcc/m2/mc-boot-ch/Gtermios.cc b/gcc/m2/mc-boot-ch/Gtermios.cc index e6f6ac898b30..a3f970d1361f 100644 --- a/gcc/m2/mc-boot-ch/Gtermios.cc +++ b/gcc/m2/mc-boot-ch/Gtermios.cc @@ -1,4 +1,4 @@ -/* Gtermios.c handwritten module for mc. +/* Gtermios.cc handwritten module for mc. Copyright (C) 2010-2023 Free Software Foundation, Inc. Contributed by Gaius Mulley . diff --git a/gcc/m2/mc-boot/GASCII.c b/gcc/m2/mc-boot/GASCII.c deleted file mode 100644 index 2f768ce24c81..000000000000 --- a/gcc/m2/mc-boot/GASCII.c +++ /dev/null @@ -1,86 +0,0 @@ -/* do not edit automatically generated by mc from ASCII. */ -/* ASCII.mod dummy companion module for the definition. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _ASCII_H -#define _ASCII_C - - -# define ASCII_nul (char) 000 -# define ASCII_soh (char) 001 -# define ASCII_stx (char) 002 -# define ASCII_etx (char) 003 -# define ASCII_eot (char) 004 -# define ASCII_enq (char) 005 -# define ASCII_ack (char) 006 -# define ASCII_bel (char) 007 -# define ASCII_bs (char) 010 -# define ASCII_ht (char) 011 -# define ASCII_nl (char) 012 -# define ASCII_vt (char) 013 -# define ASCII_np (char) 014 -# define ASCII_cr (char) 015 -# define ASCII_so (char) 016 -# define ASCII_si (char) 017 -# define ASCII_dle (char) 020 -# define ASCII_dc1 (char) 021 -# define ASCII_dc2 (char) 022 -# define ASCII_dc3 (char) 023 -# define ASCII_dc4 (char) 024 -# define ASCII_nak (char) 025 -# define ASCII_syn (char) 026 -# define ASCII_etb (char) 027 -# define ASCII_can (char) 030 -# define ASCII_em (char) 031 -# define ASCII_sub (char) 032 -# define ASCII_esc (char) 033 -# define ASCII_fs (char) 034 -# define ASCII_gs (char) 035 -# define ASCII_rs (char) 036 -# define ASCII_us (char) 037 -# define ASCII_sp (char) 040 -# define ASCII_lf ASCII_nl -# define ASCII_ff ASCII_np -# define ASCII_eof ASCII_eot -# define ASCII_tab ASCII_ht -# define ASCII_del (char) 0177 -# define ASCII_EOL ASCII_nl - -extern "C" void _M2_ASCII_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_ASCII_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GArgs.c b/gcc/m2/mc-boot/GArgs.c deleted file mode 100644 index 106ddfd30c6e..000000000000 --- a/gcc/m2/mc-boot/GArgs.c +++ /dev/null @@ -1,120 +0,0 @@ -/* do not edit automatically generated by mc from Args. */ -/* Args.mod provide access to command line arguments. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _Args_H -#define _Args_C - -# include "GUnixArgs.h" -# include "GASCII.h" - -# define MaxArgs 255 -# define MaxString 4096 -typedef struct Args__T2_a Args__T2; - -typedef Args__T2 *Args__T1; - -typedef struct Args__T3_a Args__T3; - -struct Args__T2_a { Args__T3 * array[MaxArgs+1]; }; -struct Args__T3_a { char array[MaxString+1]; }; -static Args__T1 Source; - -/* - GetArg - returns the nth argument from the command line. - The success of the operation is returned. -*/ - -extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n); - -/* - Narg - returns the number of arguments available from - command line. -*/ - -extern "C" unsigned int Args_Narg (void); - - -/* - GetArg - returns the nth argument from the command line. - The success of the operation is returned. -*/ - -extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n) -{ - int i; - unsigned int High; - unsigned int j; - - i = (int ) (n); - j = 0; - High = _a_high; - if (i < (UnixArgs_GetArgC ())) - { - Source = static_cast (UnixArgs_GetArgV ()); - while ((j < High) && ((*(*Source).array[i]).array[j] != ASCII_nul)) - { - a[j] = (*(*Source).array[i]).array[j]; - j += 1; - } - } - if (j <= High) - { - a[j] = ASCII_nul; - } - return i < (UnixArgs_GetArgC ()); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Narg - returns the number of arguments available from - command line. -*/ - -extern "C" unsigned int Args_Narg (void) -{ - return UnixArgs_GetArgC (); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_Args_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Args_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GAssertion.c b/gcc/m2/mc-boot/GAssertion.c deleted file mode 100644 index 21ee6c0b2f24..000000000000 --- a/gcc/m2/mc-boot/GAssertion.c +++ /dev/null @@ -1,71 +0,0 @@ -/* do not edit automatically generated by mc from Assertion. */ -/* Assertion.mod provides an assert procedure. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _Assertion_H -#define _Assertion_C - -# include "GStrIO.h" -# include "GM2RTS.h" - - -/* - Assert - tests the boolean Condition, if it fails then HALT is called. -*/ - -extern "C" void Assertion_Assert (unsigned int Condition); - - -/* - Assert - tests the boolean Condition, if it fails then HALT is called. -*/ - -extern "C" void Assertion_Assert (unsigned int Condition) -{ - if (! Condition) - { - StrIO_WriteString ((const char *) "assert failed - halting system", 30); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - -extern "C" void _M2_Assertion_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Assertion_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GBreak.c b/gcc/m2/mc-boot/GBreak.c deleted file mode 100644 index 9be003bd619c..000000000000 --- a/gcc/m2/mc-boot/GBreak.c +++ /dev/null @@ -1,47 +0,0 @@ -/* do not edit automatically generated by mc from Break. */ -/* Break.mod provides a dummy compatibility library for legacy systems. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _Break_H -#define _Break_C - - - -extern "C" void _M2_Break_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Break_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GCmdArgs.c b/gcc/m2/mc-boot/GCmdArgs.c deleted file mode 100644 index c304a4071825..000000000000 --- a/gcc/m2/mc-boot/GCmdArgs.c +++ /dev/null @@ -1,322 +0,0 @@ -/* do not edit automatically generated by mc from CmdArgs. */ -/* CmdArgs.mod provides procedures to retrieve arguments from strings. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _CmdArgs_H -#define _CmdArgs_C - -# include "GASCII.h" -# include "GStrLib.h" - -# define esc '\\' -# define space ' ' -# define squote '\'' -# define dquote '"' -# define tab ' ' - -/* - GetArg - takes a command line and attempts to extract argument, n, - from CmdLine. The resulting argument is placed into, a. - The result of the operation is returned. -*/ - -extern "C" unsigned int CmdArgs_GetArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int n, char *Argi, unsigned int _Argi_high); - -/* - Narg - returns the number of arguments available from - command line, CmdLine. -*/ - -extern "C" unsigned int CmdArgs_Narg (const char *CmdLine_, unsigned int _CmdLine_high); - -/* - GetNextArg - Returns true if another argument may be found. - The argument is taken from CmdLine at position Index, - Arg is filled with the found argument. -*/ - -static unsigned int GetNextArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int *CmdIndex, char *Arg, unsigned int _Arg_high); - -/* - CopyUntilSpace - copies characters until a Space character is found. -*/ - -static void CopyUntilSpace (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh); - -/* - CopyUntil - copies characters until the UntilChar is found. -*/ - -static void CopyUntil (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh, char UntilChar); - -/* - CopyChar - copies a character from string From to string To and - takes into consideration escape characters. ie \x - Where x is any character. -*/ - -static void CopyChar (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh); -static unsigned int Escape (char ch); -static unsigned int Space (char ch); -static unsigned int DoubleQuote (char ch); -static unsigned int SingleQuote (char ch); - - -/* - GetNextArg - Returns true if another argument may be found. - The argument is taken from CmdLine at position Index, - Arg is filled with the found argument. -*/ - -static unsigned int GetNextArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int *CmdIndex, char *Arg, unsigned int _Arg_high) -{ - unsigned int ArgIndex; - unsigned int HighA; - unsigned int HighC; - char CmdLine[_CmdLine_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (CmdLine, CmdLine_, _CmdLine_high+1); - - HighA = _Arg_high; /* Index into Arg */ - HighC = StrLib_StrLen ((const char *) CmdLine, _CmdLine_high); - ArgIndex = 0; - /* Skip spaces */ - while (((*CmdIndex) < HighC) && (Space (CmdLine[(*CmdIndex)]))) - { - (*CmdIndex) += 1; - } - if ((*CmdIndex) < HighC) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (SingleQuote (CmdLine[(*CmdIndex)])) - { - /* Skip over the single quote */ - (*CmdIndex) += 1; - CopyUntil ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA, squote); - (*CmdIndex) += 1; - } - else if (DoubleQuote (CmdLine[(*CmdIndex)])) - { - /* avoid dangling else. */ - /* Skip over the double quote */ - (*CmdIndex) += 1; - CopyUntil ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA, dquote); - (*CmdIndex) += 1; - } - else - { - /* avoid dangling else. */ - CopyUntilSpace ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA); - } - } - /* Skip spaces */ - while (((*CmdIndex) < HighC) && (Space (CmdLine[(*CmdIndex)]))) - { - (*CmdIndex) += 1; - } - if (ArgIndex < HighA) - { - Arg[ArgIndex] = ASCII_nul; - } - return (*CmdIndex) < HighC; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CopyUntilSpace - copies characters until a Space character is found. -*/ - -static void CopyUntilSpace (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh) -{ - char From[_From_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (From, From_, _From_high+1); - - while ((((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh)) && (! (Space (From[(*FromIndex)])))) - { - CopyChar ((const char *) From, _From_high, FromIndex, FromHigh, (char *) To, _To_high, ToIndex, ToHigh); - } -} - - -/* - CopyUntil - copies characters until the UntilChar is found. -*/ - -static void CopyUntil (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh, char UntilChar) -{ - char From[_From_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (From, From_, _From_high+1); - - while ((((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh)) && (From[(*FromIndex)] != UntilChar)) - { - CopyChar ((const char *) From, _From_high, FromIndex, FromHigh, (char *) To, _To_high, ToIndex, ToHigh); - } -} - - -/* - CopyChar - copies a character from string From to string To and - takes into consideration escape characters. ie \x - Where x is any character. -*/ - -static void CopyChar (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh) -{ - char From[_From_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (From, From_, _From_high+1); - - if (((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh)) - { - if (Escape (From[(*FromIndex)])) - { - /* Skip over Escape Character */ - (*FromIndex) += 1; - } - if ((*FromIndex) < FromHigh) - { - /* Copy Normal Character */ - To[(*ToIndex)] = From[(*FromIndex)]; - (*ToIndex) += 1; - (*FromIndex) += 1; - } - } -} - -static unsigned int Escape (char ch) -{ - return ch == esc; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -static unsigned int Space (char ch) -{ - return (ch == space) || (ch == tab); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -static unsigned int DoubleQuote (char ch) -{ - return ch == dquote; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -static unsigned int SingleQuote (char ch) -{ - return ch == squote; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetArg - takes a command line and attempts to extract argument, n, - from CmdLine. The resulting argument is placed into, a. - The result of the operation is returned. -*/ - -extern "C" unsigned int CmdArgs_GetArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int n, char *Argi, unsigned int _Argi_high) -{ - unsigned int Index; - unsigned int i; - unsigned int Another; - char CmdLine[_CmdLine_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (CmdLine, CmdLine_, _CmdLine_high+1); - - Index = 0; - /* Continually retrieve an argument until we get the n th argument. */ - i = 0; - do { - Another = GetNextArg ((const char *) CmdLine, _CmdLine_high, &Index, (char *) Argi, _Argi_high); - i += 1; - } while (! ((i > n) || ! Another)); - return i > n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Narg - returns the number of arguments available from - command line, CmdLine. -*/ - -extern "C" unsigned int CmdArgs_Narg (const char *CmdLine_, unsigned int _CmdLine_high) -{ - typedef struct Narg__T1_a Narg__T1; - - struct Narg__T1_a { char array[1000+1]; }; - Narg__T1 a; - unsigned int ArgNo; - char CmdLine[_CmdLine_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (CmdLine, CmdLine_, _CmdLine_high+1); - - ArgNo = 0; - while (CmdArgs_GetArg ((const char *) CmdLine, _CmdLine_high, ArgNo, (char *) &a.array[0], 1000)) - { - ArgNo += 1; - } - /* - IF ArgNo>0 - THEN - DEC(ArgNo) - END ; - */ - return ArgNo; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_CmdArgs_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_CmdArgs_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GDebug.c b/gcc/m2/mc-boot/GDebug.c deleted file mode 100644 index 6329abb11b16..000000000000 --- a/gcc/m2/mc-boot/GDebug.c +++ /dev/null @@ -1,168 +0,0 @@ -/* do not edit automatically generated by mc from Debug. */ -/* Debug.mod provides some simple debugging routines. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _Debug_H -#define _Debug_C - -# include "GASCII.h" -# include "GNumberIO.h" -# include "GStdIO.h" -# include "Glibc.h" -# include "GM2RTS.h" - -# define MaxNoOfDigits 12 - -/* - Halt - writes a message in the format: - Module:Line:Message - - It then terminates by calling HALT. -*/ - -extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high); - -/* - DebugString - writes a string to the debugging device (Scn.Write). - It interprets - as carriage return, linefeed. -*/ - -extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high); - -/* - WriteLn - writes a carriage return and a newline - character. -*/ - -static void WriteLn (void); - - -/* - WriteLn - writes a carriage return and a newline - character. -*/ - -static void WriteLn (void) -{ - StdIO_Write (ASCII_cr); - StdIO_Write (ASCII_lf); -} - - -/* - Halt - writes a message in the format: - Module:Line:Message - - It then terminates by calling HALT. -*/ - -extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high) -{ - typedef struct Halt__T1_a Halt__T1; - - struct Halt__T1_a { char array[MaxNoOfDigits+1]; }; - Halt__T1 No; - char Message[_Message_high+1]; - char Module[_Module_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (Message, Message_, _Message_high+1); - memcpy (Module, Module_, _Module_high+1); - - Debug_DebugString ((const char *) Module, _Module_high); /* should be large enough for most source files.. */ - NumberIO_CardToStr (LineNo, 0, (char *) &No.array[0], MaxNoOfDigits); - Debug_DebugString ((const char *) ":", 1); - Debug_DebugString ((const char *) &No.array[0], MaxNoOfDigits); - Debug_DebugString ((const char *) ":", 1); - Debug_DebugString ((const char *) Message, _Message_high); - Debug_DebugString ((const char *) "\\n", 2); - M2RTS_HALT (-1); - __builtin_unreachable (); -} - - -/* - DebugString - writes a string to the debugging device (Scn.Write). - It interprets - as carriage return, linefeed. -*/ - -extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high) -{ - unsigned int n; - unsigned int high; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - high = _a_high; - n = 0; - while ((n <= high) && (a[n] != ASCII_nul)) - { - if (a[n] == '\\') - { - /* avoid dangling else. */ - if ((n+1) <= high) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (a[n+1] == 'n') - { - WriteLn (); - n += 1; - } - else if (a[n+1] == '\\') - { - /* avoid dangling else. */ - StdIO_Write ('\\'); - n += 1; - } - } - } - else - { - StdIO_Write (a[n]); - } - n += 1; - } -} - -extern "C" void _M2_Debug_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Debug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GDynamicStrings.c b/gcc/m2/mc-boot/GDynamicStrings.c deleted file mode 100644 index dfc163646bb2..000000000000 --- a/gcc/m2/mc-boot/GDynamicStrings.c +++ /dev/null @@ -1,2676 +0,0 @@ -/* do not edit automatically generated by mc from DynamicStrings. */ -/* DynamicStrings.mod provides a dynamic string type and procedures. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _DynamicStrings_H -#define _DynamicStrings_C - -# include "Glibc.h" -# include "GStrLib.h" -# include "GStorage.h" -# include "GAssertion.h" -# include "GSYSTEM.h" -# include "GASCII.h" -# include "GM2RTS.h" - -# define MaxBuf 127 -# define PoisonOn FALSE -# define DebugOn FALSE -# define CheckOn FALSE -# define TraceOn FALSE -typedef struct DynamicStrings_Contents_r DynamicStrings_Contents; - -typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo; - -typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord; - -typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor; - -typedef DynamicStrings_descriptor *DynamicStrings_Descriptor; - -typedef struct DynamicStrings_frameRec_r DynamicStrings_frameRec; - -typedef DynamicStrings_frameRec *DynamicStrings_frame; - -typedef struct DynamicStrings__T3_a DynamicStrings__T3; - -typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState; - -typedef DynamicStrings_stringRecord *DynamicStrings_String; - -struct DynamicStrings_DebugInfo_r { - DynamicStrings_String next; - void *file; - unsigned int line; - void *proc; - }; - -struct DynamicStrings_descriptor_r { - unsigned int charStarUsed; - void *charStar; - unsigned int charStarSize; - unsigned int charStarValid; - DynamicStrings_desState state; - DynamicStrings_String garbage; - }; - -struct DynamicStrings_frameRec_r { - DynamicStrings_String alloc; - DynamicStrings_String dealloc; - DynamicStrings_frame next; - }; - -struct DynamicStrings__T3_a { char array[(MaxBuf-1)+1]; }; -struct DynamicStrings_Contents_r { - DynamicStrings__T3 buf; - unsigned int len; - DynamicStrings_String next; - }; - -struct DynamicStrings_stringRecord_r { - DynamicStrings_Contents contents; - DynamicStrings_Descriptor head; - DynamicStrings_DebugInfo debug; - }; - -static unsigned int Initialized; -static DynamicStrings_frame frameHead; -static DynamicStrings_String captured; - -/* - InitString - creates and returns a String type object. - Initial contents are, a. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high); - -/* - KillString - frees String, s, and its contents. - NIL is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s); - -/* - Fin - finishes with a string, it calls KillString with, s. - The purpose of the procedure is to provide a short cut - to calling KillString and then testing the return result. -*/ - -extern "C" void DynamicStrings_Fin (DynamicStrings_String s); - -/* - InitStringCharStar - initializes and returns a String to contain the C string. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a); - -/* - InitStringChar - initializes and returns a String to contain the single character, ch. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch); - -/* - Mark - marks String, s, ready for garbage collection. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s); - -/* - Length - returns the length of the String, s. -*/ - -extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s); - -/* - ConCat - returns String, a, after the contents of, b, have been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b); - -/* - ConCatChar - returns String, a, after character, ch, has been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch); - -/* - Assign - assigns the contents of, b, into, a. - String, a, is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b); - -/* - Dup - duplicate a String, s, returning the copy of s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s); - -/* - Add - returns a new String which contains the contents of a and b. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b); - -/* - Equal - returns TRUE if String, a, and, b, are equal. -*/ - -extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b); - -/* - EqualCharStar - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a); - -/* - EqualArray - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high); - -/* - Mult - returns a new string which is n concatenations of String, s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n); - -/* - Slice - returns a new string which contains the elements - low..high-1 - - strings start at element 0 - Slice(s, 0, 2) will return elements 0, 1 but not 2 - Slice(s, 1, 3) will return elements 1, 2 but not 3 - Slice(s, 2, 0) will return elements 2..max - Slice(s, 3, -1) will return elements 3..max-1 - Slice(s, 4, -2) will return elements 4..max-2 -*/ - -extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high); - -/* - Index - returns the indice of the first occurance of, ch, in - String, s. -1 is returned if, ch, does not exist. - The search starts at position, o. -*/ - -extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o); - -/* - RIndex - returns the indice of the last occurance of, ch, - in String, s. The search starts at position, o. - -1 is returned if, ch, is not found. -*/ - -extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o); - -/* - RemoveComment - assuming that, comment, is a comment delimiter - which indicates anything to its right is a comment - then strip off the comment and also any white space - on the remaining right hand side. - It leaves any white space on the left hand side alone. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment); - -/* - RemoveWhitePrefix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s); - -/* - RemoveWhitePostfix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s); - -/* - ToUpper - returns string, s, after it has had its lower case characters - replaced by upper case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s); - -/* - ToLower - returns string, s, after it has had its upper case characters - replaced by lower case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s); - -/* - CopyOut - copies string, s, to a. -*/ - -extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s); - -/* - char - returns the character, ch, at position, i, in String, s. -*/ - -extern "C" char DynamicStrings_char (DynamicStrings_String s, int i); - -/* - string - returns the C style char * of String, s. -*/ - -extern "C" void * DynamicStrings_string (DynamicStrings_String s); - -/* - InitStringDB - the debug version of InitString. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line); - -/* - InitStringCharStarDB - the debug version of InitStringCharStar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line); - -/* - InitStringCharDB - the debug version of InitStringChar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line); - -/* - MultDB - the debug version of MultDB. -*/ - -extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line); - -/* - DupDB - the debug version of Dup. -*/ - -extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line); - -/* - SliceDB - debug version of Slice. -*/ - -extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line); - -/* - PushAllocation - pushes the current allocation/deallocation lists. -*/ - -extern "C" void DynamicStrings_PushAllocation (void); - -/* - PopAllocation - test to see that all strings are deallocated since - the last push. Then it pops to the previous - allocation/deallocation lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" void DynamicStrings_PopAllocation (unsigned int halt); - -/* - PopAllocationExemption - test to see that all strings are deallocated, except - string, e, since the last push. - Then it pops to the previous allocation/deallocation - lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e); - -/* - writeStringDesc write out debugging information about string, s. */ - -static void writeStringDesc (DynamicStrings_String s); - -/* - writeNspace - -*/ - -static void writeNspace (unsigned int n); - -/* - DumpStringInfo - -*/ - -static void DumpStringInfo (DynamicStrings_String s, unsigned int i); - -/* - DumpStringInfo - -*/ - -static void stop (void); - -/* - doDSdbEnter - -*/ - -static void doDSdbEnter (void); - -/* - doDSdbExit - -*/ - -static void doDSdbExit (DynamicStrings_String s); - -/* - DSdbEnter - -*/ - -static void DSdbEnter (void); - -/* - DSdbExit - -*/ - -static void DSdbExit (DynamicStrings_String s); -static unsigned int Capture (DynamicStrings_String s); - -/* - Min - -*/ - -static unsigned int Min (unsigned int a, unsigned int b); - -/* - Max - -*/ - -static unsigned int Max (unsigned int a, unsigned int b); - -/* - writeString - writes a string to stdout. -*/ - -static void writeString (const char *a_, unsigned int _a_high); - -/* - writeCstring - writes a C string to stdout. -*/ - -static void writeCstring (void * a); - -/* - writeCard - -*/ - -static void writeCard (unsigned int c); - -/* - writeLongcard - -*/ - -static void writeLongcard (long unsigned int l); - -/* - writeAddress - -*/ - -static void writeAddress (void * a); - -/* - writeLn - writes a newline. -*/ - -static void writeLn (void); - -/* - AssignDebug - assigns, file, and, line, information to string, s. -*/ - -static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high); - -/* - IsOn - returns TRUE if, s, is on one of the debug lists. -*/ - -static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s); - -/* - AddTo - adds string, s, to, list. -*/ - -static void AddTo (DynamicStrings_String *list, DynamicStrings_String s); - -/* - SubFrom - removes string, s, from, list. -*/ - -static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s); - -/* - AddAllocated - adds string, s, to the head of the allocated list. -*/ - -static void AddAllocated (DynamicStrings_String s); - -/* - AddDeallocated - adds string, s, to the head of the deallocated list. -*/ - -static void AddDeallocated (DynamicStrings_String s); - -/* - IsOnAllocated - returns TRUE if the string, s, has ever been allocated. -*/ - -static unsigned int IsOnAllocated (DynamicStrings_String s); - -/* - IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated. -*/ - -static unsigned int IsOnDeallocated (DynamicStrings_String s); - -/* - SubAllocated - removes string, s, from the list of allocated strings. -*/ - -static void SubAllocated (DynamicStrings_String s); - -/* - SubDeallocated - removes string, s, from the list of deallocated strings. -*/ - -static void SubDeallocated (DynamicStrings_String s); - -/* - SubDebugInfo - removes string, s, from the list of allocated strings. -*/ - -static void SubDebugInfo (DynamicStrings_String s); - -/* - AddDebugInfo - adds string, s, to the list of allocated strings. -*/ - -static void AddDebugInfo (DynamicStrings_String s); - -/* - ConcatContents - add the contents of string, a, where, h, is the - total length of, a. The offset is in, o. -*/ - -static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o); - -/* - DeallocateCharStar - deallocates any charStar. -*/ - -static void DeallocateCharStar (DynamicStrings_String s); - -/* - CheckPoisoned - checks for a poisoned string, s. -*/ - -static DynamicStrings_String CheckPoisoned (DynamicStrings_String s); - -/* - MarkInvalid - marks the char * version of String, s, as invalid. -*/ - -static void MarkInvalid (DynamicStrings_String s); - -/* - ConcatContentsAddress - concatenate the string, a, where, h, is the - total length of, a. -*/ - -static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h); - -/* - AddToGarbage - adds String, b, onto the garbage list of, a. Providing - the state of b is marked. The state is then altered to - onlist. String, a, is returned. -*/ - -static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b); - -/* - IsOnGarbage - returns TRUE if, s, is on string, e, garbage list. -*/ - -static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s); - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch); - -/* - DumpState - -*/ - -static void DumpState (DynamicStrings_String s); - -/* - DumpStringSynopsis - -*/ - -static void DumpStringSynopsis (DynamicStrings_String s); - -/* - DumpString - displays the contents of string, s. -*/ - -static void DumpString (DynamicStrings_String s); - -/* - Init - initialize the module. -*/ - -static void Init (void); - - -/* - writeStringDesc write out debugging information about string, s. */ - -static void writeStringDesc (DynamicStrings_String s) -{ - writeCstring (s->debug.file); - writeString ((const char *) ":", 1); - writeCard (s->debug.line); - writeString ((const char *) ":", 1); - writeCstring (s->debug.proc); - writeString ((const char *) " ", 1); - writeAddress (reinterpret_cast (s)); - writeString ((const char *) " ", 1); - switch (s->head->state) - { - case DynamicStrings_inuse: - writeString ((const char *) "still in use (", 14); - writeCard (s->contents.len); - writeString ((const char *) ") characters", 12); - break; - - case DynamicStrings_marked: - writeString ((const char *) "marked", 6); - break; - - case DynamicStrings_onlist: - writeString ((const char *) "on a (lost) garbage list", 24); - break; - - case DynamicStrings_poisoned: - writeString ((const char *) "poisoned", 8); - break; - - - default: - writeString ((const char *) "unknown state", 13); - break; - } -} - - -/* - writeNspace - -*/ - -static void writeNspace (unsigned int n) -{ - while (n > 0) - { - writeString ((const char *) " ", 1); - n -= 1; - } -} - - -/* - DumpStringInfo - -*/ - -static void DumpStringInfo (DynamicStrings_String s, unsigned int i) -{ - DynamicStrings_String t; - - if (s != NULL) - { - writeNspace (i); - writeStringDesc (s); - writeLn (); - if (s->head->garbage != NULL) - { - writeNspace (i); - writeString ((const char *) "garbage list:", 13); - writeLn (); - do { - s = s->head->garbage; - DumpStringInfo (s, i+1); - writeLn (); - } while (! (s == NULL)); - } - } -} - - -/* - DumpStringInfo - -*/ - -static void stop (void) -{ -} - - -/* - doDSdbEnter - -*/ - -static void doDSdbEnter (void) -{ - if (CheckOn) - { - DynamicStrings_PushAllocation (); - } -} - - -/* - doDSdbExit - -*/ - -static void doDSdbExit (DynamicStrings_String s) -{ - if (CheckOn) - { - s = DynamicStrings_PopAllocationExemption (TRUE, s); - } -} - - -/* - DSdbEnter - -*/ - -static void DSdbEnter (void) -{ -} - - -/* - DSdbExit - -*/ - -static void DSdbExit (DynamicStrings_String s) -{ -} - -static unsigned int Capture (DynamicStrings_String s) -{ - /* - * #undef GM2_DEBUG_DYNAMICSTINGS - * #if defined(GM2_DEBUG_DYNAMICSTINGS) - * # define DSdbEnter doDSdbEnter - * # define DSdbExit doDSdbExit - * # define CheckOn TRUE - * # define TraceOn TRUE - * #endif - */ - captured = s; - return 1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Min - -*/ - -static unsigned int Min (unsigned int a, unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Max - -*/ - -static unsigned int Max (unsigned int a, unsigned int b) -{ - if (a > b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - writeString - writes a string to stdout. -*/ - -static void writeString (const char *a_, unsigned int _a_high) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = static_cast (libc_write (1, &a, static_cast (StrLib_StrLen ((const char *) a, _a_high)))); -} - - -/* - writeCstring - writes a C string to stdout. -*/ - -static void writeCstring (void * a) -{ - int i; - - if (a == NULL) - { - writeString ((const char *) "(null)", 6); - } - else - { - i = static_cast (libc_write (1, a, libc_strlen (a))); - } -} - - -/* - writeCard - -*/ - -static void writeCard (unsigned int c) -{ - char ch; - int i; - - if (c > 9) - { - writeCard (c / 10); - writeCard (c % 10); - } - else - { - ch = ((char) ( ((unsigned int) ('0'))+c)); - i = static_cast (libc_write (1, &ch, static_cast (1))); - } -} - - -/* - writeLongcard - -*/ - -static void writeLongcard (long unsigned int l) -{ - char ch; - int i; - - if (l > 16) - { - writeLongcard (l / 16); - writeLongcard (l % 16); - } - else if (l < 10) - { - /* avoid dangling else. */ - ch = ((char) ( ((unsigned int) ('0'))+((unsigned int ) (l)))); - i = static_cast (libc_write (1, &ch, static_cast (1))); - } - else if (l < 16) - { - /* avoid dangling else. */ - ch = ((char) (( ((unsigned int) ('a'))+((unsigned int ) (l)))-10)); - i = static_cast (libc_write (1, &ch, static_cast (1))); - } -} - - -/* - writeAddress - -*/ - -static void writeAddress (void * a) -{ - writeLongcard ((long unsigned int ) (a)); -} - - -/* - writeLn - writes a newline. -*/ - -static void writeLn (void) -{ - char ch; - int i; - - ch = ASCII_lf; - i = static_cast (libc_write (1, &ch, static_cast (1))); -} - - -/* - AssignDebug - assigns, file, and, line, information to string, s. -*/ - -static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high) -{ - void * f; - void * p; - char file[_file_high+1]; - char proc[_proc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - memcpy (proc, proc_, _proc_high+1); - - f = &file; - p = &proc; - Storage_ALLOCATE (&s->debug.file, (StrLib_StrLen ((const char *) file, _file_high))+1); - if ((libc_strncpy (s->debug.file, f, (StrLib_StrLen ((const char *) file, _file_high))+1)) == NULL) - {} /* empty. */ - s->debug.line = line; - Storage_ALLOCATE (&s->debug.proc, (StrLib_StrLen ((const char *) proc, _proc_high))+1); - if ((libc_strncpy (s->debug.proc, p, (StrLib_StrLen ((const char *) proc, _proc_high))+1)) == NULL) - {} /* empty. */ - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsOn - returns TRUE if, s, is on one of the debug lists. -*/ - -static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s) -{ - while ((list != s) && (list != NULL)) - { - list = list->debug.next; - } - return list == s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - AddTo - adds string, s, to, list. -*/ - -static void AddTo (DynamicStrings_String *list, DynamicStrings_String s) -{ - if ((*list) == NULL) - { - (*list) = s; - s->debug.next = NULL; - } - else - { - s->debug.next = (*list); - (*list) = s; - } -} - - -/* - SubFrom - removes string, s, from, list. -*/ - -static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s) -{ - DynamicStrings_String p; - - if ((*list) == s) - { - (*list) = s->debug.next; - } - else - { - p = (*list); - while ((p->debug.next != NULL) && (p->debug.next != s)) - { - p = p->debug.next; - } - if (p->debug.next == s) - { - p->debug.next = s->debug.next; - } - else - { - /* not found, quit */ - return ; - } - } - s->debug.next = NULL; -} - - -/* - AddAllocated - adds string, s, to the head of the allocated list. -*/ - -static void AddAllocated (DynamicStrings_String s) -{ - Init (); - AddTo (&frameHead->alloc, s); -} - - -/* - AddDeallocated - adds string, s, to the head of the deallocated list. -*/ - -static void AddDeallocated (DynamicStrings_String s) -{ - Init (); - AddTo (&frameHead->dealloc, s); -} - - -/* - IsOnAllocated - returns TRUE if the string, s, has ever been allocated. -*/ - -static unsigned int IsOnAllocated (DynamicStrings_String s) -{ - DynamicStrings_frame f; - - Init (); - f = frameHead; - do { - if (IsOn (f->alloc, s)) - { - return TRUE; - } - else - { - f = f->next; - } - } while (! (f == NULL)); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated. -*/ - -static unsigned int IsOnDeallocated (DynamicStrings_String s) -{ - DynamicStrings_frame f; - - Init (); - f = frameHead; - do { - if (IsOn (f->dealloc, s)) - { - return TRUE; - } - else - { - f = f->next; - } - } while (! (f == NULL)); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SubAllocated - removes string, s, from the list of allocated strings. -*/ - -static void SubAllocated (DynamicStrings_String s) -{ - DynamicStrings_frame f; - - Init (); - f = frameHead; - do { - if (IsOn (f->alloc, s)) - { - SubFrom (&f->alloc, s); - return ; - } - else - { - f = f->next; - } - } while (! (f == NULL)); -} - - -/* - SubDeallocated - removes string, s, from the list of deallocated strings. -*/ - -static void SubDeallocated (DynamicStrings_String s) -{ - DynamicStrings_frame f; - - Init (); - f = frameHead; - do { - if (IsOn (f->dealloc, s)) - { - SubFrom (&f->dealloc, s); - return ; - } - else - { - f = f->next; - } - } while (! (f == NULL)); -} - - -/* - SubDebugInfo - removes string, s, from the list of allocated strings. -*/ - -static void SubDebugInfo (DynamicStrings_String s) -{ - if (IsOnDeallocated (s)) - { - Assertion_Assert (! DebugOn); - /* string has already been deallocated */ - return ; - } - if (IsOnAllocated (s)) - { - SubAllocated (s); - AddDeallocated (s); - } - else - { - /* string has not been allocated */ - Assertion_Assert (! DebugOn); - } -} - - -/* - AddDebugInfo - adds string, s, to the list of allocated strings. -*/ - -static void AddDebugInfo (DynamicStrings_String s) -{ - s->debug.next = NULL; - s->debug.file = NULL; - s->debug.line = 0; - s->debug.proc = NULL; - if (CheckOn) - { - AddAllocated (s); - } -} - - -/* - ConcatContents - add the contents of string, a, where, h, is the - total length of, a. The offset is in, o. -*/ - -static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o) -{ - unsigned int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = (*c).len; - while ((o < h) && (i < MaxBuf)) - { - (*c).buf.array[i] = a[o]; - o += 1; - i += 1; - } - if (o < h) - { - (*c).len = MaxBuf; - Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord)); - (*c).next->head = NULL; - (*c).next->contents.len = 0; - (*c).next->contents.next = NULL; - ConcatContents (&(*c).next->contents, (const char *) a, _a_high, h, o); - AddDebugInfo ((*c).next); - (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14); - } - else - { - (*c).len = i; - } -} - - -/* - DeallocateCharStar - deallocates any charStar. -*/ - -static void DeallocateCharStar (DynamicStrings_String s) -{ - if ((s != NULL) && (s->head != NULL)) - { - if (s->head->charStarUsed && (s->head->charStar != NULL)) - { - Storage_DEALLOCATE (&s->head->charStar, s->head->charStarSize); - } - s->head->charStarUsed = FALSE; - s->head->charStar = NULL; - s->head->charStarSize = 0; - s->head->charStarValid = FALSE; - } -} - - -/* - CheckPoisoned - checks for a poisoned string, s. -*/ - -static DynamicStrings_String CheckPoisoned (DynamicStrings_String s) -{ - if (((PoisonOn && (s != NULL)) && (s->head != NULL)) && (s->head->state == DynamicStrings_poisoned)) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - MarkInvalid - marks the char * version of String, s, as invalid. -*/ - -static void MarkInvalid (DynamicStrings_String s) -{ - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (s->head != NULL) - { - s->head->charStarValid = FALSE; - } -} - - -/* - ConcatContentsAddress - concatenate the string, a, where, h, is the - total length of, a. -*/ - -static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h) -{ - typedef char *ConcatContentsAddress__T1; - - ConcatContentsAddress__T1 p; - unsigned int i; - unsigned int j; - - j = 0; - i = (*c).len; - p = static_cast (a); - while ((j < h) && (i < MaxBuf)) - { - (*c).buf.array[i] = (*p); - i += 1; - j += 1; - p += 1; - } - if (j < h) - { - /* avoid dangling else. */ - (*c).len = MaxBuf; - Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord)); - (*c).next->head = NULL; - (*c).next->contents.len = 0; - (*c).next->contents.next = NULL; - ConcatContentsAddress (&(*c).next->contents, reinterpret_cast (p), h-j); - AddDebugInfo ((*c).next); - if (TraceOn) - { - (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21); - } - } - else - { - (*c).len = i; - (*c).next = NULL; - } -} - - -/* - AddToGarbage - adds String, b, onto the garbage list of, a. Providing - the state of b is marked. The state is then altered to - onlist. String, a, is returned. -*/ - -static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b) -{ - DynamicStrings_String c; - - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - /* - IF (a#NIL) AND (a#b) AND (a^.head^.state=marked) - THEN - writeString('warning trying to add to a marked string') ; writeLn - END ; - */ - if (((((a != b) && (a != NULL)) && (b != NULL)) && (b->head->state == DynamicStrings_marked)) && (a->head->state == DynamicStrings_inuse)) - { - c = a; - while (c->head->garbage != NULL) - { - c = c->head->garbage; - } - c->head->garbage = b; - b->head->state = DynamicStrings_onlist; - if (CheckOn) - { - SubDebugInfo (b); - } - } - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsOnGarbage - returns TRUE if, s, is on string, e, garbage list. -*/ - -static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s) -{ - if ((e != NULL) && (s != NULL)) - { - while (e->head->garbage != NULL) - { - if (e->head->garbage == s) - { - return TRUE; - } - else - { - e = e->head->garbage; - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch) -{ - return (ch == ' ') || (ch == ASCII_tab); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DumpState - -*/ - -static void DumpState (DynamicStrings_String s) -{ - switch (s->head->state) - { - case DynamicStrings_inuse: - writeString ((const char *) "still in use (", 14); - writeCard (s->contents.len); - writeString ((const char *) ") characters", 12); - break; - - case DynamicStrings_marked: - writeString ((const char *) "marked", 6); - break; - - case DynamicStrings_onlist: - writeString ((const char *) "on a garbage list", 17); - break; - - case DynamicStrings_poisoned: - writeString ((const char *) "poisoned", 8); - break; - - - default: - writeString ((const char *) "unknown state", 13); - break; - } -} - - -/* - DumpStringSynopsis - -*/ - -static void DumpStringSynopsis (DynamicStrings_String s) -{ - writeCstring (s->debug.file); - writeString ((const char *) ":", 1); - writeCard (s->debug.line); - writeString ((const char *) ":", 1); - writeCstring (s->debug.proc); - writeString ((const char *) " string ", 8); - writeAddress (reinterpret_cast (s)); - writeString ((const char *) " ", 1); - DumpState (s); - if (IsOnAllocated (s)) - { - writeString ((const char *) " globally allocated", 19); - } - else if (IsOnDeallocated (s)) - { - /* avoid dangling else. */ - writeString ((const char *) " globally deallocated", 21); - } - else - { - /* avoid dangling else. */ - writeString ((const char *) " globally unknown", 17); - } - writeLn (); -} - - -/* - DumpString - displays the contents of string, s. -*/ - -static void DumpString (DynamicStrings_String s) -{ - DynamicStrings_String t; - - if (s != NULL) - { - DumpStringSynopsis (s); - if ((s->head != NULL) && (s->head->garbage != NULL)) - { - writeString ((const char *) "display chained strings on the garbage list", 43); - writeLn (); - t = s->head->garbage; - while (t != NULL) - { - DumpStringSynopsis (t); - t = t->head->garbage; - } - } - } -} - - -/* - Init - initialize the module. -*/ - -static void Init (void) -{ - if (! Initialized) - { - Initialized = TRUE; - frameHead = NULL; - DynamicStrings_PushAllocation (); - } -} - - -/* - InitString - creates and returns a String type object. - Initial contents are, a. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high) -{ - DynamicStrings_String s; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord)); - s->contents.len = 0; - s->contents.next = NULL; - ConcatContents (&s->contents, (const char *) a, _a_high, StrLib_StrLen ((const char *) a, _a_high), 0); - Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor)); - s->head->charStarUsed = FALSE; - s->head->charStar = NULL; - s->head->charStarSize = 0; - s->head->charStarValid = FALSE; - s->head->garbage = NULL; - s->head->state = DynamicStrings_inuse; - AddDebugInfo (s); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillString - frees String, s, and its contents. - NIL is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s) -{ - DynamicStrings_String t; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (s != NULL) - { - if (CheckOn) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (IsOnAllocated (s)) - { - SubAllocated (s); - } - else if (IsOnDeallocated (s)) - { - /* avoid dangling else. */ - SubDeallocated (s); - } - } - if (s->head != NULL) - { - s->head->state = DynamicStrings_poisoned; - s->head->garbage = DynamicStrings_KillString (s->head->garbage); - if (! PoisonOn) - { - DeallocateCharStar (s); - } - if (! PoisonOn) - { - Storage_DEALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor)); - s->head = NULL; - } - } - t = DynamicStrings_KillString (s->contents.next); - if (! PoisonOn) - { - Storage_DEALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord)); - } - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Fin - finishes with a string, it calls KillString with, s. - The purpose of the procedure is to provide a short cut - to calling KillString and then testing the return result. -*/ - -extern "C" void DynamicStrings_Fin (DynamicStrings_String s) -{ - if ((DynamicStrings_KillString (s)) != NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - InitStringCharStar - initializes and returns a String to contain the C string. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a) -{ - DynamicStrings_String s; - - Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord)); - s->contents.len = 0; - s->contents.next = NULL; - if (a != NULL) - { - ConcatContentsAddress (&s->contents, a, static_cast (libc_strlen (a))); - } - Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor)); - s->head->charStarUsed = FALSE; - s->head->charStar = NULL; - s->head->charStarSize = 0; - s->head->charStarValid = FALSE; - s->head->garbage = NULL; - s->head->state = DynamicStrings_inuse; - AddDebugInfo (s); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitStringChar - initializes and returns a String to contain the single character, ch. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch) -{ - typedef struct InitStringChar__T4_a InitStringChar__T4; - - struct InitStringChar__T4_a { char array[1+1]; }; - InitStringChar__T4 a; - DynamicStrings_String s; - - a.array[0] = ch; - a.array[1] = ASCII_nul; - s = DynamicStrings_InitString ((const char *) &a.array[0], 1); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Mark - marks String, s, ready for garbage collection. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s) -{ - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if ((s != NULL) && (s->head->state == DynamicStrings_inuse)) - { - s->head->state = DynamicStrings_marked; - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Length - returns the length of the String, s. -*/ - -extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s) -{ - if (s == NULL) - { - return 0; - } - else - { - return s->contents.len+(DynamicStrings_Length (s->contents.next)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConCat - returns String, a, after the contents of, b, have been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b) -{ - DynamicStrings_String t; - - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - if (a == b) - { - return DynamicStrings_ConCat (a, DynamicStrings_Mark (DynamicStrings_Dup (b))); - } - else if (a != NULL) - { - /* avoid dangling else. */ - a = AddToGarbage (a, b); - MarkInvalid (a); - t = a; - while (b != NULL) - { - while ((t->contents.len == MaxBuf) && (t->contents.next != NULL)) - { - t = t->contents.next; - } - ConcatContents (&t->contents, (const char *) &b->contents.buf.array[0], (MaxBuf-1), b->contents.len, 0); - b = b->contents.next; - } - } - if ((a == NULL) && (b != NULL)) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConCatChar - returns String, a, after character, ch, has been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch) -{ - typedef struct ConCatChar__T5_a ConCatChar__T5; - - struct ConCatChar__T5_a { char array[1+1]; }; - ConCatChar__T5 b; - DynamicStrings_String t; - - if (PoisonOn) - { - a = CheckPoisoned (a); - } - b.array[0] = ch; - b.array[1] = ASCII_nul; - t = a; - MarkInvalid (a); - while ((t->contents.len == MaxBuf) && (t->contents.next != NULL)) - { - t = t->contents.next; - } - ConcatContents (&t->contents, (const char *) &b.array[0], 1, 1, 0); - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Assign - assigns the contents of, b, into, a. - String, a, is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b) -{ - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - if ((a != NULL) && (b != NULL)) - { - a->contents.next = DynamicStrings_KillString (a->contents.next); - a->contents.len = 0; - } - return DynamicStrings_ConCat (a, b); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Dup - duplicate a String, s, returning the copy of s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s) -{ - if (PoisonOn) - { - s = CheckPoisoned (s); - } - s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Add - returns a new String which contains the contents of a and b. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b) -{ - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b); - if (TraceOn) - { - a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3); - } - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Equal - returns TRUE if String, a, and, b, are equal. -*/ - -extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b) -{ - unsigned int i; - - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - if ((DynamicStrings_Length (a)) == (DynamicStrings_Length (b))) - { - while ((a != NULL) && (b != NULL)) - { - i = 0; - Assertion_Assert (a->contents.len == b->contents.len); - while (i < a->contents.len) - { - if (a->contents.buf.array[i] != b->contents.buf.array[i]) - { - return FALSE; - } - i += 1; - } - a = a->contents.next; - b = b->contents.next; - } - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EqualCharStar - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a) -{ - DynamicStrings_String t; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - t = DynamicStrings_InitStringCharStar (a); - if (TraceOn) - { - t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13); - } - t = AddToGarbage (t, s); - if (DynamicStrings_Equal (t, s)) - { - t = DynamicStrings_KillString (t); - return TRUE; - } - else - { - t = DynamicStrings_KillString (t); - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EqualArray - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high) -{ - DynamicStrings_String t; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - t = DynamicStrings_InitString ((const char *) a, _a_high); - if (TraceOn) - { - t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10); - } - t = AddToGarbage (t, s); - if (DynamicStrings_Equal (t, s)) - { - t = DynamicStrings_KillString (t); - return TRUE; - } - else - { - t = DynamicStrings_KillString (t); - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Mult - returns a new string which is n concatenations of String, s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n) -{ - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (n <= 0) - { - s = AddToGarbage (DynamicStrings_InitString ((const char *) "", 0), s); - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_Mult (s, n-1), s); - } - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Slice - returns a new string which contains the elements - low..high-1 - - strings start at element 0 - Slice(s, 0, 2) will return elements 0, 1 but not 2 - Slice(s, 1, 3) will return elements 1, 2 but not 3 - Slice(s, 2, 0) will return elements 2..max - Slice(s, 3, -1) will return elements 3..max-1 - Slice(s, 4, -2) will return elements 4..max-2 -*/ - -extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high) -{ - DynamicStrings_String d; - DynamicStrings_String t; - int start; - int end; - int o; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (low < 0) - { - low = ((int ) (DynamicStrings_Length (s)))+low; - } - if (high <= 0) - { - high = ((int ) (DynamicStrings_Length (s)))+high; - } - else - { - /* make sure high is <= Length (s) */ - high = Min (DynamicStrings_Length (s), static_cast (high)); - } - d = DynamicStrings_InitString ((const char *) "", 0); - d = AddToGarbage (d, s); - o = 0; - t = d; - while (s != NULL) - { - if (low < (o+((int ) (s->contents.len)))) - { - if (o > high) - { - s = NULL; - } - else - { - /* found sliceable unit */ - if (low < o) - { - start = 0; - } - else - { - start = low-o; - } - end = Max (Min (MaxBuf, static_cast (high-o)), 0); - while (t->contents.len == MaxBuf) - { - if (t->contents.next == NULL) - { - Storage_ALLOCATE ((void **) &t->contents.next, sizeof (DynamicStrings_stringRecord)); - t->contents.next->head = NULL; - t->contents.next->contents.len = 0; - AddDebugInfo (t->contents.next); - if (TraceOn) - { - t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5); - } - } - t = t->contents.next; - } - ConcatContentsAddress (&t->contents, &s->contents.buf.array[start], static_cast (end-start)); - o += s->contents.len; - s = s->contents.next; - } - } - else - { - o += s->contents.len; - s = s->contents.next; - } - } - if (TraceOn) - { - d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5); - } - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Index - returns the indice of the first occurance of, ch, in - String, s. -1 is returned if, ch, does not exist. - The search starts at position, o. -*/ - -extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o) -{ - unsigned int i; - unsigned int k; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - k = 0; - while (s != NULL) - { - if ((k+s->contents.len) < o) - { - k += s->contents.len; - } - else - { - i = o-k; - while (i < s->contents.len) - { - if (s->contents.buf.array[i] == ch) - { - return k+i; - } - i += 1; - } - k += i; - o = k; - } - s = s->contents.next; - } - return -1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RIndex - returns the indice of the last occurance of, ch, - in String, s. The search starts at position, o. - -1 is returned if, ch, is not found. -*/ - -extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o) -{ - unsigned int i; - unsigned int k; - int j; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - j = -1; - k = 0; - while (s != NULL) - { - if ((k+s->contents.len) < o) - { - k += s->contents.len; - } - else - { - if (o < k) - { - i = 0; - } - else - { - i = o-k; - } - while (i < s->contents.len) - { - if (s->contents.buf.array[i] == ch) - { - j = k; - } - k += 1; - i += 1; - } - } - s = s->contents.next; - } - return j; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveComment - assuming that, comment, is a comment delimiter - which indicates anything to its right is a comment - then strip off the comment and also any white space - on the remaining right hand side. - It leaves any white space on the left hand side alone. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment) -{ - int i; - - i = DynamicStrings_Index (s, comment, 0); - if (i == 0) - { - s = DynamicStrings_InitString ((const char *) "", 0); - } - else if (i > 0) - { - /* avoid dangling else. */ - s = DynamicStrings_RemoveWhitePostfix (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i)); - } - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveWhitePrefix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s) -{ - unsigned int i; - - i = 0; - while (IsWhite (DynamicStrings_char (s, static_cast (i)))) - { - i += 1; - } - s = DynamicStrings_Slice (s, (int ) (i), 0); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveWhitePostfix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s) -{ - int i; - - i = ((int ) (DynamicStrings_Length (s)))-1; - while ((i >= 0) && (IsWhite (DynamicStrings_char (s, i)))) - { - i -= 1; - } - s = DynamicStrings_Slice (s, 0, i+1); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ToUpper - returns string, s, after it has had its lower case characters - replaced by upper case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s) -{ - char ch; - unsigned int i; - DynamicStrings_String t; - - if (s != NULL) - { - MarkInvalid (s); - t = s; - while (t != NULL) - { - i = 0; - while (i < t->contents.len) - { - ch = t->contents.buf.array[i]; - if ((ch >= 'a') && (ch <= 'z')) - { - t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A')))); - } - i += 1; - } - t = t->contents.next; - } - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ToLower - returns string, s, after it has had its upper case characters - replaced by lower case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s) -{ - char ch; - unsigned int i; - DynamicStrings_String t; - - if (s != NULL) - { - MarkInvalid (s); - t = s; - while (t != NULL) - { - i = 0; - while (i < t->contents.len) - { - ch = t->contents.buf.array[i]; - if ((ch >= 'A') && (ch <= 'Z')) - { - t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a')))); - } - i += 1; - } - t = t->contents.next; - } - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CopyOut - copies string, s, to a. -*/ - -extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s) -{ - unsigned int i; - unsigned int l; - - l = Min (_a_high+1, DynamicStrings_Length (s)); - i = 0; - while (i < l) - { - a[i] = DynamicStrings_char (s, static_cast (i)); - i += 1; - } - if (i <= _a_high) - { - a[i] = ASCII_nul; - } -} - - -/* - char - returns the character, ch, at position, i, in String, s. -*/ - -extern "C" char DynamicStrings_char (DynamicStrings_String s, int i) -{ - unsigned int c; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (i < 0) - { - c = (unsigned int ) (((int ) (DynamicStrings_Length (s)))+i); - } - else - { - c = i; - } - while ((s != NULL) && (c >= s->contents.len)) - { - c -= s->contents.len; - s = s->contents.next; - } - if ((s == NULL) || (c >= s->contents.len)) - { - return ASCII_nul; - } - else - { - return s->contents.buf.array[c]; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - string - returns the C style char * of String, s. -*/ - -extern "C" void * DynamicStrings_string (DynamicStrings_String s) -{ - typedef char *string__T2; - - DynamicStrings_String a; - unsigned int l; - unsigned int i; - string__T2 p; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (s == NULL) - { - return NULL; - } - else - { - if (! s->head->charStarValid) - { - l = DynamicStrings_Length (s); - if (! (s->head->charStarUsed && (s->head->charStarSize > l))) - { - DeallocateCharStar (s); - Storage_ALLOCATE (&s->head->charStar, l+1); - s->head->charStarSize = l+1; - s->head->charStarUsed = TRUE; - } - p = static_cast (s->head->charStar); - a = s; - while (a != NULL) - { - i = 0; - while (i < a->contents.len) - { - (*p) = a->contents.buf.array[i]; - i += 1; - p += 1; - } - a = a->contents.next; - } - (*p) = ASCII_nul; - s->head->charStarValid = TRUE; - } - return s->head->charStar; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitStringDB - the debug version of InitString. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line) -{ - char a[_a_high+1]; - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_InitString ((const char *) a, _a_high), (const char *) file, _file_high, line, (const char *) "InitString", 10); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitStringCharStarDB - the debug version of InitStringCharStar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_InitStringCharStar (a), (const char *) file, _file_high, line, (const char *) "InitStringCharStar", 18); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitStringCharDB - the debug version of InitStringChar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_InitStringChar (ch), (const char *) file, _file_high, line, (const char *) "InitStringChar", 14); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - MultDB - the debug version of MultDB. -*/ - -extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_Mult (s, n), (const char *) file, _file_high, line, (const char *) "Mult", 4); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DupDB - the debug version of Dup. -*/ - -extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_Dup (s), (const char *) file, _file_high, line, (const char *) "Dup", 3); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SliceDB - debug version of Slice. -*/ - -extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - DSdbEnter (); - s = AssignDebug (DynamicStrings_Slice (s, low, high), (const char *) file, _file_high, line, (const char *) "Slice", 5); - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PushAllocation - pushes the current allocation/deallocation lists. -*/ - -extern "C" void DynamicStrings_PushAllocation (void) -{ - DynamicStrings_frame f; - - if (CheckOn) - { - Init (); - Storage_ALLOCATE ((void **) &f, sizeof (DynamicStrings_frameRec)); - f->next = frameHead; - f->alloc = NULL; - f->dealloc = NULL; - frameHead = f; - } -} - - -/* - PopAllocation - test to see that all strings are deallocated since - the last push. Then it pops to the previous - allocation/deallocation lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" void DynamicStrings_PopAllocation (unsigned int halt) -{ - if (CheckOn) - { - if ((DynamicStrings_PopAllocationExemption (halt, NULL)) == NULL) - {} /* empty. */ - } -} - - -/* - PopAllocationExemption - test to see that all strings are deallocated, except - string, e, since the last push. - Then it pops to the previous allocation/deallocation - lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e) -{ - DynamicStrings_String s; - DynamicStrings_frame f; - unsigned int b; - - Init (); - if (CheckOn) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (frameHead == NULL) - { - stop (); - /* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") */ - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65); - } - else - { - if (frameHead->alloc != NULL) - { - b = FALSE; - s = frameHead->alloc; - while (s != NULL) - { - if (! (((e == s) || (IsOnGarbage (e, s))) || (IsOnGarbage (s, e)))) - { - if (! b) - { - writeString ((const char *) "the following strings have been lost", 36); - writeLn (); - b = TRUE; - } - DumpStringInfo (s, 0); - } - s = s->debug.next; - } - if (b && halt) - { - libc_exit (1); - } - } - frameHead = frameHead->next; - } - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_DynamicStrings_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Initialized = FALSE; - Init (); -} - -extern "C" void _M2_DynamicStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GEnvironment.c b/gcc/m2/mc-boot/GEnvironment.c deleted file mode 100644 index aa5e76628730..000000000000 --- a/gcc/m2/mc-boot/GEnvironment.c +++ /dev/null @@ -1,129 +0,0 @@ -/* do not edit automatically generated by mc from Environment. */ -/* Environment.mod provides access to the environment settings of a process. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _Environment_H -#define _Environment_C - -# include "GSYSTEM.h" -# include "Glibc.h" -# include "GASCII.h" -# include "GStrLib.h" - - -/* - GetEnvironment - gets the environment variable Env and places - a copy of its value into string, dest. - It returns TRUE if the string Env was found in - the processes environment. -*/ - -extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high); - -/* - PutEnvironment - change or add an environment variable definition EnvDef. - TRUE is returned if the environment variable was - set or changed successfully. -*/ - -extern "C" unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high); - - -/* - GetEnvironment - gets the environment variable Env and places - a copy of its value into string, dest. - It returns TRUE if the string Env was found in - the processes environment. -*/ - -extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high) -{ - typedef char *GetEnvironment__T1; - - unsigned int High; - unsigned int i; - GetEnvironment__T1 Addr; - char Env[_Env_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (Env, Env_, _Env_high+1); - - i = 0; - High = _dest_high; - Addr = static_cast (libc_getenv (&Env)); - while (((i < High) && (Addr != NULL)) && ((*Addr) != ASCII_nul)) - { - dest[i] = (*Addr); - Addr += 1; - i += 1; - } - if (i < High) - { - dest[i] = ASCII_nul; - } - return Addr != NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PutEnvironment - change or add an environment variable definition EnvDef. - TRUE is returned if the environment variable was - set or changed successfully. -*/ - -extern "C" unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high) -{ - char EnvDef[_EnvDef_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (EnvDef, EnvDef_, _EnvDef_high+1); - - return (libc_putenv (&EnvDef)) == 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_Environment_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Environment_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GFIO.c b/gcc/m2/mc-boot/GFIO.c deleted file mode 100644 index 65819a10a4b8..000000000000 --- a/gcc/m2/mc-boot/GFIO.c +++ /dev/null @@ -1,2322 +0,0 @@ -/* do not edit automatically generated by mc from FIO. */ -/* FIO.mod provides a simple buffered file input/output library. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _FIO_H -#define _FIO_C - -# include "GSYSTEM.h" -# include "GASCII.h" -# include "GStrLib.h" -# include "GStorage.h" -# include "GNumberIO.h" -# include "Glibc.h" -# include "GIndexing.h" -# include "GM2RTS.h" - -typedef unsigned int FIO_File; - -FIO_File FIO_StdErr; -FIO_File FIO_StdOut; -FIO_File FIO_StdIn; -# define SEEK_SET 0 -# define SEEK_END 2 -# define UNIXREADONLY 0 -# define UNIXWRITEONLY 1 -# define CreatePermissions 0666 -# define MaxBufferLength (1024*16) -# define MaxErrorString (1024*8) -typedef struct FIO_NameInfo_r FIO_NameInfo; - -typedef struct FIO_buf_r FIO_buf; - -typedef FIO_buf *FIO_Buffer; - -typedef struct FIO_fds_r FIO_fds; - -typedef FIO_fds *FIO_FileDescriptor; - -typedef struct FIO__T7_a FIO__T7; - -typedef char *FIO_PtrToChar; - -typedef enum {FIO_successful, FIO_outofmemory, FIO_toomanyfilesopen, FIO_failed, FIO_connectionfailure, FIO_endofline, FIO_endoffile} FIO_FileStatus; - -typedef enum {FIO_unused, FIO_openedforread, FIO_openedforwrite, FIO_openedforrandom} FIO_FileUsage; - -struct FIO_NameInfo_r { - void *address; - unsigned int size; - }; - -struct FIO_buf_r { - unsigned int valid; - long int bufstart; - unsigned int position; - void *address; - unsigned int filled; - unsigned int size; - unsigned int left; - FIO__T7 *contents; - }; - -struct FIO__T7_a { char array[MaxBufferLength+1]; }; -struct FIO_fds_r { - int unixfd; - FIO_NameInfo name; - FIO_FileStatus state; - FIO_FileUsage usage; - unsigned int output; - FIO_Buffer buffer; - long int abspos; - }; - -static Indexing_Index FileInfo; -static FIO_File Error; - -/* - IsNoError - returns a TRUE if no error has occured on file, f. -*/ - -extern "C" unsigned int FIO_IsNoError (FIO_File f); - -/* - IsActive - returns TRUE if the file, f, is still active. -*/ - -extern "C" unsigned int FIO_IsActive (FIO_File f); -extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile); - -/* - Close - close a file which has been previously opened using: - OpenToRead, OpenToWrite, OpenForRandom. - It is correct to close a file which has an error status. -*/ - -extern "C" void FIO_Close (FIO_File f); - -/* - exists - returns TRUE if a file named, fname exists for reading. -*/ - -extern "C" unsigned int FIO_exists (void * fname, unsigned int flength); - -/* - openToRead - attempts to open a file, fname, for reading and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength); - -/* - openToWrite - attempts to open a file, fname, for write and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength); - -/* - openForRandom - attempts to open a file, fname, for random access - read or write and it returns this file. - The success of this operation can be checked by - calling IsNoError. - towrite, determines whether the file should be - opened for writing or reading. -*/ - -extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile); - -/* - FlushBuffer - flush contents of file, f. -*/ - -extern "C" void FIO_FlushBuffer (FIO_File f); - -/* - ReadNBytes - reads nBytes of a file into memory area, dest, returning - the number of bytes actually read. - This function will consume from the buffer and then - perform direct libc reads. It is ideal for large reads. -*/ - -extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest); - -/* - ReadAny - reads HIGH(a) bytes into, a. All input - is fully buffered, unlike ReadNBytes and thus is more - suited to small reads. -*/ - -extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high); - -/* - WriteNBytes - writes nBytes from memory area src to a file - returning the number of bytes actually written. - This function will flush the buffer and then - write the nBytes using a direct write from libc. - It is ideal for large writes. -*/ - -extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src); - -/* - WriteAny - writes HIGH(a) bytes onto, file, f. All output - is fully buffered, unlike WriteNBytes and thus is more - suited to small writes. -*/ - -extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high); - -/* - WriteChar - writes a single character to file, f. -*/ - -extern "C" void FIO_WriteChar (FIO_File f, char ch); - -/* - EOF - tests to see whether a file, f, has reached end of file. -*/ - -extern "C" unsigned int FIO_EOF (FIO_File f); - -/* - EOLN - tests to see whether a file, f, is upon a newline. - It does NOT consume the newline. -*/ - -extern "C" unsigned int FIO_EOLN (FIO_File f); - -/* - WasEOLN - tests to see whether a file, f, has just seen a newline. -*/ - -extern "C" unsigned int FIO_WasEOLN (FIO_File f); - -/* - ReadChar - returns a character read from file f. - Sensible to check with IsNoError or EOF after calling - this function. -*/ - -extern "C" char FIO_ReadChar (FIO_File f); - -/* - UnReadChar - replaces a character, ch, back into file f. - This character must have been read by ReadChar - and it does not allow successive calls. It may - only be called if the previous read was successful - or end of file was seen. - If the state was previously endoffile then it - is altered to successful. - Otherwise it is left alone. -*/ - -extern "C" void FIO_UnReadChar (FIO_File f, char ch); - -/* - WriteLine - writes out a linefeed to file, f. -*/ - -extern "C" void FIO_WriteLine (FIO_File f); - -/* - WriteString - writes a string to file, f. -*/ - -extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high); - -/* - ReadString - reads a string from file, f, into string, a. - It terminates the string if HIGH is reached or - if a newline is seen or an error occurs. -*/ - -extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high); - -/* - WriteCardinal - writes a CARDINAL to file, f. - It writes the binary image of the cardinal - to file, f. -*/ - -extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c); - -/* - ReadCardinal - reads a CARDINAL from file, f. - It reads a binary image of a CARDINAL - from a file, f. -*/ - -extern "C" unsigned int FIO_ReadCardinal (FIO_File f); - -/* - GetUnixFileDescriptor - returns the UNIX file descriptor of a file. -*/ - -extern "C" int FIO_GetUnixFileDescriptor (FIO_File f); - -/* - SetPositionFromBeginning - sets the position from the beginning of the file. -*/ - -extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos); - -/* - SetPositionFromEnd - sets the position from the end of the file. -*/ - -extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos); - -/* - FindPosition - returns the current absolute position in file, f. -*/ - -extern "C" long int FIO_FindPosition (FIO_File f); - -/* - GetFileName - assigns, a, with the filename associated with, f. -*/ - -extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high); - -/* - getFileName - returns the address of the filename associated with, f. -*/ - -extern "C" void * FIO_getFileName (FIO_File f); - -/* - getFileNameLength - returns the number of characters associated with filename, f. -*/ - -extern "C" unsigned int FIO_getFileNameLength (FIO_File f); - -/* - FlushOutErr - flushes, StdOut, and, StdErr. - It is also called when the application calls M2RTS.Terminate. - (which is automatically placed in program modules by the GM2 - scaffold). -*/ - -extern "C" void FIO_FlushOutErr (void); - -/* - Max - returns the maximum of two values. -*/ - -static unsigned int Max (unsigned int a, unsigned int b); - -/* - Min - returns the minimum of two values. -*/ - -static unsigned int Min (unsigned int a, unsigned int b); - -/* - GetNextFreeDescriptor - returns the index to the FileInfo array indicating - the next free slot. -*/ - -static FIO_File GetNextFreeDescriptor (void); - -/* - SetState - sets the field, state, of file, f, to, s. -*/ - -static void SetState (FIO_File f, FIO_FileStatus s); - -/* - InitializeFile - initialize a file descriptor -*/ - -static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength); - -/* - ConnectToUnix - connects a FIO file to a UNIX file descriptor. -*/ - -static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile); - -/* - ReadFromBuffer - attempts to read, nBytes, from file, f. - It firstly consumes the buffer and then performs - direct unbuffered reads. This should only be used - when wishing to read large files. - - The actual number of bytes read is returned. - -1 is returned if EOF is reached. -*/ - -static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes); - -/* - BufferedRead - will read, nBytes, through the buffer. - Similar to ReadFromBuffer, but this function will always - read into the buffer before copying into memory. - - Useful when performing small reads. -*/ - -static int BufferedRead (FIO_File f, unsigned int nBytes, void * a); - -/* - HandleEscape - translates - and \t into their respective ascii codes. -*/ - -static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest); - -/* - Cast - casts a := b -*/ - -static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high); - -/* - StringFormat1 - converts string, src, into, dest, together with encapsulated - entity, w. It only formats the first %s or %d with n. -*/ - -static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high); - -/* - FormatError - provides a orthoganal counterpart to the procedure below. -*/ - -static void FormatError (const char *a_, unsigned int _a_high); - -/* - FormatError1 - generic error procedure taking standard format string - and single parameter. -*/ - -static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - FormatError2 - generic error procedure taking standard format string - and two parameters. -*/ - -static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); - -/* - CheckAccess - checks to see whether a file f has been - opened for read/write. -*/ - -static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite); - -/* - SetEndOfLine - -*/ - -static void SetEndOfLine (FIO_File f, char ch); - -/* - BufferedWrite - will write, nBytes, through the buffer. - Similar to WriteNBytes, but this function will always - write into the buffer before copying into memory. - - Useful when performing small writes. -*/ - -static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a); - -/* - PreInitialize - preinitialize the file descriptor. -*/ - -static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize); - -/* - Init - initialize the modules, global variables. -*/ - -static void Init (void); - - -/* - Max - returns the maximum of two values. -*/ - -static unsigned int Max (unsigned int a, unsigned int b) -{ - if (a > b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Min - returns the minimum of two values. -*/ - -static unsigned int Min (unsigned int a, unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetNextFreeDescriptor - returns the index to the FileInfo array indicating - the next free slot. -*/ - -static FIO_File GetNextFreeDescriptor (void) -{ - FIO_File f; - FIO_File h; - FIO_FileDescriptor fd; - - f = Error+1; - h = Indexing_HighIndice (FileInfo); - for (;;) - { - if (f <= h) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - return f; - } - } - f += 1; - if (f > h) - { - Indexing_PutIndice (FileInfo, f, NULL); /* create new slot */ - return f; /* create new slot */ - } - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1); - __builtin_unreachable (); -} - - -/* - SetState - sets the field, state, of file, f, to, s. -*/ - -static void SetState (FIO_File f, FIO_FileStatus s) -{ - FIO_FileDescriptor fd; - - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - fd->state = s; -} - - -/* - InitializeFile - initialize a file descriptor -*/ - -static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength) -{ - FIO_PtrToChar p; - FIO_FileDescriptor fd; - - Storage_ALLOCATE ((void **) &fd, sizeof (FIO_fds)); - if (fd == NULL) - { - SetState (Error, FIO_outofmemory); - return Error; - } - else - { - Indexing_PutIndice (FileInfo, f, reinterpret_cast (fd)); - fd->name.size = flength+1; /* need to guarantee the nul for C */ - fd->usage = use; /* need to guarantee the nul for C */ - fd->output = towrite; - Storage_ALLOCATE (&fd->name.address, fd->name.size); - if (fd->name.address == NULL) - { - fd->state = FIO_outofmemory; - return f; - } - fd->name.address = libc_strncpy (fd->name.address, fname, flength); - /* and assign nul to the last byte */ - p = static_cast (fd->name.address); - p += flength; - (*p) = ASCII_nul; - fd->abspos = 0; - /* now for the buffer */ - Storage_ALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf)); - if (fd->buffer == NULL) - { - SetState (Error, FIO_outofmemory); - return Error; - } - else - { - fd->buffer->valid = FALSE; - fd->buffer->bufstart = 0; - fd->buffer->size = buflength; - fd->buffer->position = 0; - fd->buffer->filled = 0; - if (fd->buffer->size == 0) - { - fd->buffer->address = NULL; - } - else - { - Storage_ALLOCATE (&fd->buffer->address, fd->buffer->size); - if (fd->buffer->address == NULL) - { - fd->state = FIO_outofmemory; - return f; - } - } - if (towrite) - { - fd->buffer->left = fd->buffer->size; - } - else - { - fd->buffer->left = 0; - } - fd->buffer->contents = reinterpret_cast (fd->buffer->address); /* provides easy access for reading characters */ - fd->state = fstate; /* provides easy access for reading characters */ - } - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConnectToUnix - connects a FIO file to a UNIX file descriptor. -*/ - -static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - if (towrite) - { - if (newfile) - { - fd->unixfd = libc_creat (fd->name.address, CreatePermissions); - } - else - { - fd->unixfd = libc_open (fd->name.address, UNIXWRITEONLY, 0); - } - } - else - { - fd->unixfd = libc_open (fd->name.address, UNIXREADONLY, 0); - } - if (fd->unixfd < 0) - { - fd->state = FIO_connectionfailure; - } - } - } -} - - -/* - ReadFromBuffer - attempts to read, nBytes, from file, f. - It firstly consumes the buffer and then performs - direct unbuffered reads. This should only be used - when wishing to read large files. - - The actual number of bytes read is returned. - -1 is returned if EOF is reached. -*/ - -static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes) -{ - typedef unsigned char *ReadFromBuffer__T1; - - void * t; - int result; - unsigned int total; - unsigned int n; - ReadFromBuffer__T1 p; - FIO_FileDescriptor fd; - - if (f != Error) - { - total = 0; /* how many bytes have we read */ - fd = static_cast (Indexing_GetIndice (FileInfo, f)); /* how many bytes have we read */ - /* extract from the buffer first */ - if ((fd->buffer != NULL) && fd->buffer->valid) - { - if (fd->buffer->left > 0) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (nBytes == 1) - { - /* too expensive to call memcpy for 1 character */ - p = static_cast (a); - (*p) = static_cast ((*fd->buffer->contents).array[fd->buffer->position]); - fd->buffer->left -= 1; /* remove consumed bytes */ - fd->buffer->position += 1; /* move onwards n bytes */ - nBytes = 0; - /* read */ - return 1; - } - else - { - n = Min (fd->buffer->left, nBytes); - t = fd->buffer->address; - t = reinterpret_cast (reinterpret_cast (t)+fd->buffer->position); - p = static_cast (libc_memcpy (a, t, static_cast (n))); - fd->buffer->left -= n; /* remove consumed bytes */ - fd->buffer->position += n; /* move onwards n bytes */ - /* move onwards ready for direct reads */ - a = reinterpret_cast (reinterpret_cast (a)+n); - nBytes -= n; /* reduce the amount for future direct */ - /* read */ - total += n; - return total; /* much cleaner to return now, */ - } - /* difficult to record an error if */ - } - /* the read below returns -1 */ - } - if (nBytes > 0) - { - /* still more to read */ - result = static_cast (libc_read (fd->unixfd, a, static_cast ((int ) (nBytes)))); - if (result > 0) - { - /* avoid dangling else. */ - total += result; - fd->abspos += result; - /* now disable the buffer as we read directly into, a. */ - if (fd->buffer != NULL) - { - fd->buffer->valid = FALSE; - } - } - else - { - if (result == 0) - { - /* eof reached */ - fd->state = FIO_endoffile; - } - else - { - fd->state = FIO_failed; - } - /* indicate buffer is empty */ - if (fd->buffer != NULL) - { - fd->buffer->valid = FALSE; - fd->buffer->left = 0; - fd->buffer->position = 0; - if (fd->buffer->address != NULL) - { - (*fd->buffer->contents).array[fd->buffer->position] = ASCII_nul; - } - } - return -1; - } - } - return total; - } - else - { - return -1; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - BufferedRead - will read, nBytes, through the buffer. - Similar to ReadFromBuffer, but this function will always - read into the buffer before copying into memory. - - Useful when performing small reads. -*/ - -static int BufferedRead (FIO_File f, unsigned int nBytes, void * a) -{ - typedef unsigned char *BufferedRead__T3; - - void * t; - int result; - int total; - int n; - BufferedRead__T3 p; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - total = 0; /* how many bytes have we read */ - if (fd != NULL) /* how many bytes have we read */ - { - /* extract from the buffer first */ - if (fd->buffer != NULL) - { - while (nBytes > 0) - { - if ((fd->buffer->left > 0) && fd->buffer->valid) - { - if (nBytes == 1) - { - /* too expensive to call memcpy for 1 character */ - p = static_cast (a); - (*p) = static_cast ((*fd->buffer->contents).array[fd->buffer->position]); - fd->buffer->left -= 1; /* remove consumed byte */ - fd->buffer->position += 1; /* move onwards n byte */ - total += 1; /* move onwards n byte */ - return total; - } - else - { - n = Min (fd->buffer->left, nBytes); - t = fd->buffer->address; - t = reinterpret_cast (reinterpret_cast (t)+fd->buffer->position); - p = static_cast (libc_memcpy (a, t, static_cast (n))); - fd->buffer->left -= n; /* remove consumed bytes */ - fd->buffer->position += n; /* move onwards n bytes */ - /* move onwards ready for direct reads */ - a = reinterpret_cast (reinterpret_cast (a)+n); - nBytes -= n; /* reduce the amount for future direct */ - /* read */ - total += n; - } - } - else - { - /* refill buffer */ - n = static_cast (libc_read (fd->unixfd, fd->buffer->address, static_cast (fd->buffer->size))); - if (n >= 0) - { - /* avoid dangling else. */ - fd->buffer->valid = TRUE; - fd->buffer->position = 0; - fd->buffer->left = n; - fd->buffer->filled = n; - fd->buffer->bufstart = fd->abspos; - fd->abspos += n; - if (n == 0) - { - /* eof reached */ - fd->state = FIO_endoffile; - return -1; - } - } - else - { - fd->buffer->valid = FALSE; - fd->buffer->position = 0; - fd->buffer->left = 0; - fd->buffer->filled = 0; - fd->state = FIO_failed; - return total; - } - } - } - return total; - } - } - } - return -1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - HandleEscape - translates - and \t into their respective ascii codes. -*/ - -static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest) -{ - char src[_src_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (src, src_, _src_high+1); - - if (((((*i)+1) < HighSrc) && (src[(*i)] == '\\')) && ((*j) < HighDest)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (src[(*i)+1] == 'n') - { - /* requires a newline */ - dest[(*j)] = ASCII_nl; - (*j) += 1; - (*i) += 2; - } - else if (src[(*i)+1] == 't') - { - /* avoid dangling else. */ - /* requires a tab (yuck) tempted to fake this but I better not.. */ - dest[(*j)] = ASCII_tab; - (*j) += 1; - (*i) += 2; - } - else - { - /* avoid dangling else. */ - /* copy escaped character */ - (*i) += 1; - dest[(*j)] = src[(*i)]; - (*j) += 1; - (*i) += 1; - } - } -} - - -/* - Cast - casts a := b -*/ - -static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (b, b_, _b_high+1); - - if (_a_high == _b_high) - { - for (i=0; i<=_a_high; i++) - { - a[i] = b[i]; - } - } - else - { - FormatError ((const char *) "cast failed", 11); - } -} - - -/* - StringFormat1 - converts string, src, into, dest, together with encapsulated - entity, w. It only formats the first %s or %d with n. -*/ - -static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high) -{ - typedef struct StringFormat1__T8_a StringFormat1__T8; - - typedef char *StringFormat1__T4; - - struct StringFormat1__T8_a { char array[MaxErrorString+1]; }; - unsigned int HighSrc; - unsigned int HighDest; - unsigned int c; - unsigned int i; - unsigned int j; - StringFormat1__T8 str; - StringFormat1__T4 p; - char src[_src_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (src, src_, _src_high+1); - memcpy (w, w_, _w_high+1); - - HighSrc = StrLib_StrLen ((const char *) src, _src_high); - HighDest = _dest_high; - p = NULL; - c = 0; - i = 0; - j = 0; - while ((((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) && (src[i] != '%')) - { - if (src[i] == '\\') - { - HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest); - } - else - { - dest[j] = src[i]; - i += 1; - j += 1; - } - } - if ((((i+1) < HighSrc) && (src[i] == '%')) && (j < HighDest)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (src[i+1] == 's') - { - Cast ((unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) w, _w_high); - while ((j < HighDest) && ((*p) != ASCII_nul)) - { - dest[j] = (*p); - j += 1; - p += 1; - } - if (j < HighDest) - { - dest[j] = ASCII_nul; - } - j = StrLib_StrLen ((const char *) dest, _dest_high); - i += 2; - } - else if (src[i+1] == 'd') - { - /* avoid dangling else. */ - dest[j] = ASCII_nul; - Cast ((unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) w, _w_high); - NumberIO_CardToStr (c, 0, (char *) &str.array[0], MaxErrorString); - StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxErrorString, (char *) dest, _dest_high); - j = StrLib_StrLen ((const char *) dest, _dest_high); - i += 2; - } - else - { - /* avoid dangling else. */ - dest[j] = src[i]; - i += 1; - j += 1; - } - } - /* and finish off copying src into dest */ - while (((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) - { - if (src[i] == '\\') - { - HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest); - } - else - { - dest[j] = src[i]; - i += 1; - j += 1; - } - } - if (j < HighDest) - { - dest[j] = ASCII_nul; - } -} - - -/* - FormatError - provides a orthoganal counterpart to the procedure below. -*/ - -static void FormatError (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - FIO_WriteString (FIO_StdErr, (const char *) a, _a_high); -} - - -/* - FormatError1 - generic error procedure taking standard format string - and single parameter. -*/ - -static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - typedef struct FormatError1__T9_a FormatError1__T9; - - struct FormatError1__T9_a { char array[MaxErrorString+1]; }; - FormatError1__T9 s; - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w, _w_high); - FormatError ((const char *) &s.array[0], MaxErrorString); -} - - -/* - FormatError2 - generic error procedure taking standard format string - and two parameters. -*/ - -static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - typedef struct FormatError2__T10_a FormatError2__T10; - - struct FormatError2__T10_a { char array[MaxErrorString+1]; }; - FormatError2__T10 s; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high); - FormatError1 ((const char *) &s.array[0], MaxErrorString, (const unsigned char *) w2, _w2_high); -} - - -/* - CheckAccess - checks to see whether a file f has been - opened for read/write. -*/ - -static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - /* avoid dangling else. */ - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - if (f != FIO_StdErr) - { - FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96); - } - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - if ((use == FIO_openedforwrite) && (fd->usage == FIO_openedforread)) - { - FormatError1 ((const char *) "this file (%s) has been opened for reading but is now being written\\n", 69, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else if ((use == FIO_openedforread) && (fd->usage == FIO_openedforwrite)) - { - /* avoid dangling else. */ - FormatError1 ((const char *) "this file (%s) has been opened for writing but is now being read\\n", 66, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else if (fd->state == FIO_connectionfailure) - { - /* avoid dangling else. */ - FormatError1 ((const char *) "this file (%s) was not successfully opened\\n", 44, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else if (towrite != fd->output) - { - /* avoid dangling else. */ - if (fd->output) - { - FormatError1 ((const char *) "this file (%s) was opened for writing but is now being read\\n", 61, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - FormatError1 ((const char *) "this file (%s) was opened for reading but is now being written\\n", 64, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - } - } - else - { - FormatError ((const char *) "this file has not been opened successfully\\n", 44); - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - SetEndOfLine - -*/ - -static void SetEndOfLine (FIO_File f, char ch) -{ - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforread, FALSE); - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (ch == ASCII_nl) - { - fd->state = FIO_endofline; - } - else - { - fd->state = FIO_successful; - } - } -} - - -/* - BufferedWrite - will write, nBytes, through the buffer. - Similar to WriteNBytes, but this function will always - write into the buffer before copying into memory. - - Useful when performing small writes. -*/ - -static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a) -{ - typedef unsigned char *BufferedWrite__T5; - - void * t; - int result; - int total; - int n; - BufferedWrite__T5 p; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - total = 0; /* how many bytes have we read */ - if (fd->buffer != NULL) /* how many bytes have we read */ - { - /* place into the buffer first */ - while (nBytes > 0) - { - if (fd->buffer->left > 0) - { - if (nBytes == 1) - { - /* too expensive to call memcpy for 1 character */ - p = static_cast (a); - (*fd->buffer->contents).array[fd->buffer->position] = static_cast ((*p)); - fd->buffer->left -= 1; /* reduce space */ - fd->buffer->position += 1; /* move onwards n byte */ - total += 1; /* move onwards n byte */ - return total; - } - else - { - n = Min (fd->buffer->left, nBytes); - t = fd->buffer->address; - t = reinterpret_cast (reinterpret_cast (t)+fd->buffer->position); - p = static_cast (libc_memcpy (a, t, static_cast ((unsigned int ) (n)))); - fd->buffer->left -= n; /* remove consumed bytes */ - fd->buffer->position += n; /* move onwards n bytes */ - /* move ready for further writes */ - a = reinterpret_cast (reinterpret_cast (a)+n); - nBytes -= n; /* reduce the amount for future writes */ - total += n; /* reduce the amount for future writes */ - } - } - else - { - FIO_FlushBuffer (f); - if ((fd->state != FIO_successful) && (fd->state != FIO_endofline)) - { - nBytes = 0; - } - } - } - return total; - } - } - } - return -1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PreInitialize - preinitialize the file descriptor. -*/ - -static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize) -{ - FIO_FileDescriptor fd; - FIO_FileDescriptor fe; - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - if ((InitializeFile (f, &fname, StrLib_StrLen ((const char *) fname, _fname_high), state, use, towrite, bufsize)) == f) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (f == Error) - { - fe = static_cast (Indexing_GetIndice (FileInfo, FIO_StdErr)); - if (fe == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - fd->unixfd = fe->unixfd; /* the error channel */ - } - } - else - { - fd->unixfd = osfd; - } - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - Init - initialize the modules, global variables. -*/ - -static void Init (void) -{ - FileInfo = Indexing_InitIndex (0); - Error = 0; - PreInitialize (Error, (const char *) "error", 5, FIO_toomanyfilesopen, FIO_unused, FALSE, -1, 0); - FIO_StdIn = 1; - PreInitialize (FIO_StdIn, (const char *) "", 7, FIO_successful, FIO_openedforread, FALSE, 0, MaxBufferLength); - FIO_StdOut = 2; - PreInitialize (FIO_StdOut, (const char *) "", 8, FIO_successful, FIO_openedforwrite, TRUE, 1, MaxBufferLength); - FIO_StdErr = 3; - PreInitialize (FIO_StdErr, (const char *) "", 8, FIO_successful, FIO_openedforwrite, TRUE, 2, MaxBufferLength); - if (! (M2RTS_InstallTerminationProcedure ((PROC ) {(PROC_t) FIO_FlushOutErr}))) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - IsNoError - returns a TRUE if no error has occured on file, f. -*/ - -extern "C" unsigned int FIO_IsNoError (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f == Error) - { - return FALSE; - } - else - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - return (fd != NULL) && (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsActive - returns TRUE if the file, f, is still active. -*/ - -extern "C" unsigned int FIO_IsActive (FIO_File f) -{ - if (f == Error) - { - return FALSE; - } - else - { - return (Indexing_GetIndice (FileInfo, f)) != NULL; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high) -{ - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - /* - The following functions are wrappers for the above. - */ - return FIO_exists (&fname, StrLib_StrLen ((const char *) fname, _fname_high)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high) -{ - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - return FIO_openToRead (&fname, StrLib_StrLen ((const char *) fname, _fname_high)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high) -{ - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - return FIO_openToWrite (&fname, StrLib_StrLen ((const char *) fname, _fname_high)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile) -{ - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - return FIO_openForRandom (&fname, StrLib_StrLen ((const char *) fname, _fname_high), towrite, newfile); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Close - close a file which has been previously opened using: - OpenToRead, OpenToWrite, OpenForRandom. - It is correct to close a file which has an error status. -*/ - -extern "C" void FIO_Close (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - /* - we allow users to close files which have an error status - */ - if (fd != NULL) - { - FIO_FlushBuffer (f); - if (fd->unixfd >= 0) - { - if ((libc_close (fd->unixfd)) != 0) - { - FormatError1 ((const char *) "failed to close file (%s)\\n", 27, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - fd->state = FIO_failed; /* --fixme-- too late to notify user (unless we return a BOOLEAN) */ - } - } - if (fd->name.address != NULL) - { - Storage_DEALLOCATE (&fd->name.address, fd->name.size); - } - if (fd->buffer != NULL) - { - if (fd->buffer->address != NULL) - { - Storage_DEALLOCATE (&fd->buffer->address, fd->buffer->size); - } - Storage_DEALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf)); - fd->buffer = NULL; - } - Storage_DEALLOCATE ((void **) &fd, sizeof (FIO_fds)); - Indexing_PutIndice (FileInfo, f, NULL); - } - } -} - - -/* - exists - returns TRUE if a file named, fname exists for reading. -*/ - -extern "C" unsigned int FIO_exists (void * fname, unsigned int flength) -{ - FIO_File f; - - f = FIO_openToRead (fname, flength); - if (FIO_IsNoError (f)) - { - FIO_Close (f); - return TRUE; - } - else - { - FIO_Close (f); - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openToRead - attempts to open a file, fname, for reading and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength) -{ - FIO_File f; - - f = GetNextFreeDescriptor (); - if (f == Error) - { - SetState (f, FIO_toomanyfilesopen); - } - else - { - f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforread, FALSE, MaxBufferLength); - ConnectToUnix (f, FALSE, FALSE); - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openToWrite - attempts to open a file, fname, for write and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength) -{ - FIO_File f; - - f = GetNextFreeDescriptor (); - if (f == Error) - { - SetState (f, FIO_toomanyfilesopen); - } - else - { - f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforwrite, TRUE, MaxBufferLength); - ConnectToUnix (f, TRUE, TRUE); - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openForRandom - attempts to open a file, fname, for random access - read or write and it returns this file. - The success of this operation can be checked by - calling IsNoError. - towrite, determines whether the file should be - opened for writing or reading. -*/ - -extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile) -{ - FIO_File f; - - f = GetNextFreeDescriptor (); - if (f == Error) - { - SetState (f, FIO_toomanyfilesopen); - } - else - { - f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforrandom, towrite, MaxBufferLength); - ConnectToUnix (f, towrite, newfile); - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FlushBuffer - flush contents of file, f. -*/ - -extern "C" void FIO_FlushBuffer (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - if (fd->output && (fd->buffer != NULL)) - { - if ((fd->buffer->position == 0) || ((libc_write (fd->unixfd, fd->buffer->address, static_cast (fd->buffer->position))) == ((int ) (fd->buffer->position)))) - { - fd->abspos += fd->buffer->position; - fd->buffer->bufstart = fd->abspos; - fd->buffer->position = 0; - fd->buffer->filled = 0; - fd->buffer->left = fd->buffer->size; - } - else - { - fd->state = FIO_failed; - } - } - } - } -} - - -/* - ReadNBytes - reads nBytes of a file into memory area, dest, returning - the number of bytes actually read. - This function will consume from the buffer and then - perform direct libc reads. It is ideal for large reads. -*/ - -extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest) -{ - typedef char *ReadNBytes__T2; - - int n; - ReadNBytes__T2 p; - - if (f != Error) - { - CheckAccess (f, FIO_openedforread, FALSE); - n = ReadFromBuffer (f, dest, nBytes); - if (n <= 0) - { - return 0; - } - else - { - p = static_cast (dest); - p += n-1; - SetEndOfLine (f, (*p)); - return n; - } - } - else - { - return 0; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ReadAny - reads HIGH(a) bytes into, a. All input - is fully buffered, unlike ReadNBytes and thus is more - suited to small reads. -*/ - -extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high) -{ - CheckAccess (f, FIO_openedforread, FALSE); - if ((BufferedRead (f, _a_high, a)) == ((int ) (_a_high))) - { - SetEndOfLine (f, static_cast (a[_a_high])); - } -} - - -/* - WriteNBytes - writes nBytes from memory area src to a file - returning the number of bytes actually written. - This function will flush the buffer and then - write the nBytes using a direct write from libc. - It is ideal for large writes. -*/ - -extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src) -{ - int total; - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforwrite, TRUE); - FIO_FlushBuffer (f); - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - total = static_cast (libc_write (fd->unixfd, src, static_cast ((int ) (nBytes)))); - if (total < 0) - { - fd->state = FIO_failed; - return 0; - } - else - { - fd->abspos += (unsigned int ) (total); - if (fd->buffer != NULL) - { - fd->buffer->bufstart = fd->abspos; - } - return (unsigned int ) (total); - } - } - } - return 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WriteAny - writes HIGH(a) bytes onto, file, f. All output - is fully buffered, unlike WriteNBytes and thus is more - suited to small writes. -*/ - -extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high) -{ - CheckAccess (f, FIO_openedforwrite, TRUE); - if ((BufferedWrite (f, _a_high, a)) == ((int ) (_a_high))) - {} /* empty. */ -} - - -/* - WriteChar - writes a single character to file, f. -*/ - -extern "C" void FIO_WriteChar (FIO_File f, char ch) -{ - CheckAccess (f, FIO_openedforwrite, TRUE); - if ((BufferedWrite (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch)))) - {} /* empty. */ -} - - -/* - EOF - tests to see whether a file, f, has reached end of file. -*/ - -extern "C" unsigned int FIO_EOF (FIO_File f) -{ - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforread, FALSE); - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - return fd->state == FIO_endoffile; - } - } - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EOLN - tests to see whether a file, f, is upon a newline. - It does NOT consume the newline. -*/ - -extern "C" unsigned int FIO_EOLN (FIO_File f) -{ - char ch; - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforread, FALSE); - /* - we will read a character and then push it back onto the input stream, - having noted the file status, we also reset the status. - */ - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - if ((fd->state == FIO_successful) || (fd->state == FIO_endofline)) - { - ch = FIO_ReadChar (f); - if ((fd->state == FIO_successful) || (fd->state == FIO_endofline)) - { - FIO_UnReadChar (f, ch); - } - return ch == ASCII_nl; - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WasEOLN - tests to see whether a file, f, has just seen a newline. -*/ - -extern "C" unsigned int FIO_WasEOLN (FIO_File f) -{ - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforread, FALSE); - if (f == Error) - { - return FALSE; - } - else - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - return (fd != NULL) && (fd->state == FIO_endofline); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ReadChar - returns a character read from file f. - Sensible to check with IsNoError or EOF after calling - this function. -*/ - -extern "C" char FIO_ReadChar (FIO_File f) -{ - char ch; - - CheckAccess (f, FIO_openedforread, FALSE); - if ((BufferedRead (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch)))) - { - SetEndOfLine (f, ch); - return ch; - } - else - { - return ASCII_nul; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - UnReadChar - replaces a character, ch, back into file f. - This character must have been read by ReadChar - and it does not allow successive calls. It may - only be called if the previous read was successful - or end of file was seen. - If the state was previously endoffile then it - is altered to successful. - Otherwise it is left alone. -*/ - -extern "C" void FIO_UnReadChar (FIO_File f, char ch) -{ - FIO_FileDescriptor fd; - unsigned int n; - void * a; - void * b; - - CheckAccess (f, FIO_openedforread, FALSE); - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline)) - { - /* avoid dangling else. */ - if ((fd->buffer != NULL) && fd->buffer->valid) - { - /* we assume that a ReadChar has occurred, we will check just in case. */ - if (fd->state == FIO_endoffile) - { - fd->buffer->position = MaxBufferLength; - fd->buffer->left = 0; - fd->buffer->filled = 0; - fd->state = FIO_successful; - } - if (fd->buffer->position > 0) - { - fd->buffer->position -= 1; - fd->buffer->left += 1; - (*fd->buffer->contents).array[fd->buffer->position] = ch; - } - else - { - /* if possible make room and store ch */ - if (fd->buffer->filled == fd->buffer->size) - { - FormatError1 ((const char *) "performing too many UnReadChar calls on file (%d)\\n", 51, (const unsigned char *) &f, (sizeof (f)-1)); - } - else - { - n = fd->buffer->filled-fd->buffer->position; - b = &(*fd->buffer->contents).array[fd->buffer->position]; - a = &(*fd->buffer->contents).array[fd->buffer->position+1]; - a = libc_memcpy (a, b, static_cast (n)); - fd->buffer->filled += 1; - (*fd->buffer->contents).array[fd->buffer->position] = ch; - } - } - } - } - else - { - FormatError1 ((const char *) "UnReadChar can only be called if the previous read was successful or end of file, error on file (%d)\\n", 102, (const unsigned char *) &f, (sizeof (f)-1)); - } - } -} - - -/* - WriteLine - writes out a linefeed to file, f. -*/ - -extern "C" void FIO_WriteLine (FIO_File f) -{ - FIO_WriteChar (f, ASCII_nl); -} - - -/* - WriteString - writes a string to file, f. -*/ - -extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high) -{ - unsigned int l; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - l = StrLib_StrLen ((const char *) a, _a_high); - if ((FIO_WriteNBytes (f, l, &a)) != l) - {} /* empty. */ -} - - -/* - ReadString - reads a string from file, f, into string, a. - It terminates the string if HIGH is reached or - if a newline is seen or an error occurs. -*/ - -extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high) -{ - unsigned int high; - unsigned int i; - char ch; - - CheckAccess (f, FIO_openedforread, FALSE); - high = _a_high; - i = 0; - do { - ch = FIO_ReadChar (f); - if (i <= high) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (((ch == ASCII_nl) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f))) - { - a[i] = ASCII_nul; - i += 1; - } - else - { - a[i] = ch; - i += 1; - } - } - } while (! ((((ch == ASCII_nl) || (i > high)) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f)))); -} - - -/* - WriteCardinal - writes a CARDINAL to file, f. - It writes the binary image of the cardinal - to file, f. -*/ - -extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c) -{ - FIO_WriteAny (f, (unsigned char *) &c, (sizeof (c)-1)); -} - - -/* - ReadCardinal - reads a CARDINAL from file, f. - It reads a binary image of a CARDINAL - from a file, f. -*/ - -extern "C" unsigned int FIO_ReadCardinal (FIO_File f) -{ - unsigned int c; - - FIO_ReadAny (f, (unsigned char *) &c, (sizeof (c)-1)); - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetUnixFileDescriptor - returns the UNIX file descriptor of a file. -*/ - -extern "C" int FIO_GetUnixFileDescriptor (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - return fd->unixfd; - } - } - FormatError1 ((const char *) "file %d has not been opened or is out of range\\n", 48, (const unsigned char *) &f, (sizeof (f)-1)); - return -1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SetPositionFromBeginning - sets the position from the beginning of the file. -*/ - -extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos) -{ - long int offset; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - /* always force the lseek, until we are confident that abspos is always correct, - basically it needs some hard testing before we should remove the OR TRUE. */ - if ((fd->abspos != pos) || TRUE) - { - FIO_FlushBuffer (f); - if (fd->buffer != NULL) - { - if (fd->output) - { - fd->buffer->left = fd->buffer->size; - } - else - { - fd->buffer->left = 0; - } - fd->buffer->position = 0; - fd->buffer->filled = 0; - } - offset = libc_lseek (fd->unixfd, pos, SEEK_SET); - if ((offset >= 0) && (pos == offset)) - { - fd->abspos = pos; - } - else - { - fd->state = FIO_failed; - fd->abspos = 0; - } - if (fd->buffer != NULL) - { - fd->buffer->valid = FALSE; - fd->buffer->bufstart = fd->abspos; - } - } - } - } -} - - -/* - SetPositionFromEnd - sets the position from the end of the file. -*/ - -extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos) -{ - long int offset; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - FIO_FlushBuffer (f); - if (fd->buffer != NULL) - { - if (fd->output) - { - fd->buffer->left = fd->buffer->size; - } - else - { - fd->buffer->left = 0; - } - fd->buffer->position = 0; - fd->buffer->filled = 0; - } - offset = libc_lseek (fd->unixfd, pos, SEEK_END); - if (offset >= 0) - { - fd->abspos = offset; - } - else - { - fd->state = FIO_failed; - fd->abspos = 0; - offset = 0; - } - if (fd->buffer != NULL) - { - fd->buffer->valid = FALSE; - fd->buffer->bufstart = offset; - } - } - } -} - - -/* - FindPosition - returns the current absolute position in file, f. -*/ - -extern "C" long int FIO_FindPosition (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - if ((fd->buffer == NULL) || ! fd->buffer->valid) - { - return fd->abspos; - } - else - { - return fd->buffer->bufstart+((long int ) (fd->buffer->position)); - } - } - } - return 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetFileName - assigns, a, with the filename associated with, f. -*/ - -extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high) -{ - typedef char *GetFileName__T6; - - unsigned int i; - GetFileName__T6 p; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - if (fd->name.address == NULL) - { - StrLib_StrCopy ((const char *) "", 0, (char *) a, _a_high); - } - else - { - p = static_cast (fd->name.address); - i = 0; - while (((*p) != ASCII_nul) && (i <= _a_high)) - { - a[i] = (*p); - p += 1; - i += 1; - } - } - } - } -} - - -/* - getFileName - returns the address of the filename associated with, f. -*/ - -extern "C" void * FIO_getFileName (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return fd->name.address; - } - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getFileNameLength - returns the number of characters associated with filename, f. -*/ - -extern "C" unsigned int FIO_getFileNameLength (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return fd->name.size; - } - } - return 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FlushOutErr - flushes, StdOut, and, StdErr. - It is also called when the application calls M2RTS.Terminate. - (which is automatically placed in program modules by the GM2 - scaffold). -*/ - -extern "C" void FIO_FlushOutErr (void) -{ - if (FIO_IsNoError (FIO_StdOut)) - { - FIO_FlushBuffer (FIO_StdOut); - } - if (FIO_IsNoError (FIO_StdErr)) - { - FIO_FlushBuffer (FIO_StdErr); - } -} - -extern "C" void _M2_FIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_FIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - FIO_FlushOutErr (); -} diff --git a/gcc/m2/mc-boot/GFormatStrings.c b/gcc/m2/mc-boot/GFormatStrings.c deleted file mode 100644 index 78e7a5a559c5..000000000000 --- a/gcc/m2/mc-boot/GFormatStrings.c +++ /dev/null @@ -1,845 +0,0 @@ -/* do not edit automatically generated by mc from FormatStrings. */ -/* FormatStrings.mod provides a pseudo printf capability. - -Copyright (C) 2005-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _FormatStrings_H -#define _FormatStrings_C - -# include "GDynamicStrings.h" -# include "GStringConvert.h" -# include "GSYSTEM.h" -# include "GASCII.h" -# include "GM2RTS.h" - - -/* - Sprintf0 - returns a String containing, s, after it has had its - escape sequences translated. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt); - -/* - Sprintf1 - returns a String containing, s, together with encapsulated - entity, w. It only formats the first %s or %d with n. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high); - -/* - Sprintf2 - returns a string, s, which has been formatted. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); - -/* - Sprintf3 - returns a string, s, which has been formatted. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); - -/* - Sprintf4 - returns a string, s, which has been formatted. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high); - -/* - HandleEscape - translates \a, \b, \e, \f, -, \r, \x[hex] \[octal] into - their respective ascii codes. It also converts \[any] into - a single [any] character. -*/ - -extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s); - -/* - doDSdbEnter - -*/ - -static void doDSdbEnter (void); - -/* - doDSdbExit - -*/ - -static void doDSdbExit (DynamicStrings_String s); - -/* - DSdbEnter - -*/ - -static void DSdbEnter (void); - -/* - DSdbExit - -*/ - -static void DSdbExit (DynamicStrings_String s); - -/* - IsDigit - returns TRUE if ch lies in the range: 0..9 -*/ - -static unsigned int IsDigit (char ch); - -/* - Cast - casts a := b -*/ - -static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high); - -/* - isHex - -*/ - -static unsigned int isHex (char ch); - -/* - toHex - -*/ - -static unsigned int toHex (char ch); - -/* - toOct - -*/ - -static unsigned int toOct (char ch); - -/* - isOct - -*/ - -static unsigned int isOct (char ch); - -/* - FormatString - returns a String containing, s, together with encapsulated - entity, w. It only formats the first %s or %d or %u with n. - A new string is returned. -*/ - -static DynamicStrings_String FormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high); - -/* - FormatString - returns a String containing, s, together with encapsulated - entity, w. It only formats the first %s or %d or %u with n. - A new string is returned. -*/ - -static DynamicStrings_String PerformFormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high); - -/* - Copy - copies, fmt[start:end] -> in and returns in. Providing that start >= 0. -*/ - -static DynamicStrings_String Copy (DynamicStrings_String fmt, DynamicStrings_String in, int start, int end); - -/* - HandlePercent - pre-condition: s, is a string. - Post-condition: a new string is returned which is a copy of, - s, except %% is transformed into %. -*/ - -static DynamicStrings_String HandlePercent (DynamicStrings_String fmt, DynamicStrings_String s, int startpos); - - -/* - doDSdbEnter - -*/ - -static void doDSdbEnter (void) -{ - DynamicStrings_PushAllocation (); -} - - -/* - doDSdbExit - -*/ - -static void doDSdbExit (DynamicStrings_String s) -{ - s = DynamicStrings_PopAllocationExemption (TRUE, s); -} - - -/* - DSdbEnter - -*/ - -static void DSdbEnter (void) -{ -} - - -/* - DSdbExit - -*/ - -static void DSdbExit (DynamicStrings_String s) -{ -} - - -/* - IsDigit - returns TRUE if ch lies in the range: 0..9 -*/ - -static unsigned int IsDigit (char ch) -{ - return (ch >= '0') && (ch <= '9'); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Cast - casts a := b -*/ - -static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (b, b_, _b_high+1); - - if (_a_high == _b_high) - { - for (i=0; i<=_a_high; i++) - { - a[i] = b[i]; - } - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - isHex - -*/ - -static unsigned int isHex (char ch) -{ - return (((ch >= '0') && (ch <= '9')) || ((ch >= 'A') && (ch <= 'F'))) || ((ch >= 'a') && (ch <= 'f')); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - toHex - -*/ - -static unsigned int toHex (char ch) -{ - if ((ch >= '0') && (ch <= '9')) - { - return ((unsigned int) (ch))- ((unsigned int) ('0')); - } - else if ((ch >= 'A') && (ch <= 'F')) - { - /* avoid dangling else. */ - return ( ((unsigned int) (ch))- ((unsigned int) ('A')))+10; - } - else - { - /* avoid dangling else. */ - return ( ((unsigned int) (ch))- ((unsigned int) ('a')))+10; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - toOct - -*/ - -static unsigned int toOct (char ch) -{ - return ((unsigned int) (ch))- ((unsigned int) ('0')); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isOct - -*/ - -static unsigned int isOct (char ch) -{ - return (ch >= '0') && (ch <= '8'); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FormatString - returns a String containing, s, together with encapsulated - entity, w. It only formats the first %s or %d or %u with n. - A new string is returned. -*/ - -static DynamicStrings_String FormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high) -{ - DynamicStrings_String s; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (w, w_, _w_high+1); - - DSdbEnter (); - if ((*startpos) >= 0) - { - s = PerformFormatString (fmt, startpos, in, (const unsigned char *) w, _w_high); - } - else - { - s = DynamicStrings_Dup (in); - } - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FormatString - returns a String containing, s, together with encapsulated - entity, w. It only formats the first %s or %d or %u with n. - A new string is returned. -*/ - -static DynamicStrings_String PerformFormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high) -{ - unsigned int left; - unsigned int u; - int c; - int width; - int nextperc; - int afterperc; - int endpos; - char leader; - char ch; - char ch2; - DynamicStrings_String p; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (w, w_, _w_high+1); - - while ((*startpos) >= 0) - { - nextperc = DynamicStrings_Index (fmt, '%', static_cast ((*startpos))); - afterperc = nextperc; - if (nextperc >= 0) - { - afterperc += 1; - if ((DynamicStrings_char (fmt, afterperc)) == '-') - { - left = TRUE; - afterperc += 1; - } - else - { - left = FALSE; - } - ch = DynamicStrings_char (fmt, afterperc); - if (ch == '0') - { - leader = '0'; - } - else - { - leader = ' '; - } - width = 0; - while (IsDigit (ch)) - { - width = (width*10)+((int ) ( ((unsigned int) (ch))- ((unsigned int) ('0')))); - afterperc += 1; - ch = DynamicStrings_char (fmt, afterperc); - } - if ((ch == 'c') || (ch == 's')) - { - afterperc += 1; - if (ch == 'c') - { - ch2 = static_cast (w[0]); - p = DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "", 0), ch2); - } - else - { - Cast ((unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) w, _w_high); - p = DynamicStrings_Dup (p); - } - if ((width > 0) && (((int ) (DynamicStrings_Length (p))) < width)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (left) - { - /* place trailing spaces after, p. */ - p = DynamicStrings_ConCat (p, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " ", 1)), static_cast (width-((int ) (DynamicStrings_Length (p))))))); - } - else - { - /* padd string, p, with leading spaces. */ - p = DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " ", 1)), static_cast (width-((int ) (DynamicStrings_Length (p))))), DynamicStrings_Mark (p)); - } - } - /* include string, p, into, in. */ - if (nextperc > 0) - { - in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc)); - } - in = DynamicStrings_ConCat (in, p); - (*startpos) = afterperc; - DSdbExit (static_cast (NULL)); - return in; - } - else if (ch == 'd') - { - /* avoid dangling else. */ - afterperc += 1; - Cast ((unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) w, _w_high); - in = Copy (fmt, in, (*startpos), nextperc); - in = DynamicStrings_ConCat (in, StringConvert_IntegerToString (c, static_cast (width), leader, FALSE, 10, FALSE)); - (*startpos) = afterperc; - DSdbExit (static_cast (NULL)); - return in; - } - else if (ch == 'x') - { - /* avoid dangling else. */ - afterperc += 1; - Cast ((unsigned char *) &u, (sizeof (u)-1), (const unsigned char *) w, _w_high); - in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc)); - in = DynamicStrings_ConCat (in, StringConvert_CardinalToString (u, static_cast (width), leader, 16, TRUE)); - (*startpos) = afterperc; - DSdbExit (static_cast (NULL)); - return in; - } - else if (ch == 'u') - { - /* avoid dangling else. */ - afterperc += 1; - Cast ((unsigned char *) &u, (sizeof (u)-1), (const unsigned char *) w, _w_high); - in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc)); - in = DynamicStrings_ConCat (in, StringConvert_CardinalToString (u, static_cast (width), leader, 10, FALSE)); - (*startpos) = afterperc; - DSdbExit (static_cast (NULL)); - return in; - } - else - { - /* avoid dangling else. */ - afterperc += 1; - /* copy format string. */ - if (nextperc > 0) - { - in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc)); - } - /* and the character after the %. */ - in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_InitStringChar (ch))); - } - (*startpos) = afterperc; - } - else - { - /* nothing to do. */ - DSdbExit (static_cast (NULL)); - return in; - } - } - DSdbExit (static_cast (NULL)); - return in; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Copy - copies, fmt[start:end] -> in and returns in. Providing that start >= 0. -*/ - -static DynamicStrings_String Copy (DynamicStrings_String fmt, DynamicStrings_String in, int start, int end) -{ - if (start >= 0) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (end > 0) - { - in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_Slice (fmt, start, end))); - } - else if (end < 0) - { - /* avoid dangling else. */ - in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_Slice (fmt, start, 0))); - } - } - return in; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - HandlePercent - pre-condition: s, is a string. - Post-condition: a new string is returned which is a copy of, - s, except %% is transformed into %. -*/ - -static DynamicStrings_String HandlePercent (DynamicStrings_String fmt, DynamicStrings_String s, int startpos) -{ - int prevpos; - DynamicStrings_String result; - - if ((startpos == ((int ) (DynamicStrings_Length (fmt)))) || (startpos < 0)) - { - return s; - } - else - { - prevpos = startpos; - while ((startpos >= 0) && (prevpos < ((int ) (DynamicStrings_Length (fmt))))) - { - startpos = DynamicStrings_Index (fmt, '%', static_cast (startpos)); - if (startpos >= prevpos) - { - if (startpos > 0) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Slice (fmt, prevpos, startpos))); - } - startpos += 1; - if ((DynamicStrings_char (fmt, startpos)) == '%') - { - s = DynamicStrings_ConCatChar (s, '%'); - startpos += 1; - } - prevpos = startpos; - } - } - if (prevpos < ((int ) (DynamicStrings_Length (fmt)))) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Slice (fmt, prevpos, 0))); - } - return s; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Sprintf0 - returns a String containing, s, after it has had its - escape sequences translated. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt) -{ - DynamicStrings_String s; - - DSdbEnter (); - fmt = FormatStrings_HandleEscape (fmt); - s = HandlePercent (fmt, DynamicStrings_InitString ((const char *) "", 0), 0); - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Sprintf1 - returns a String containing, s, together with encapsulated - entity, w. It only formats the first %s or %d with n. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high) -{ - int i; - DynamicStrings_String s; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (w, w_, _w_high+1); - - DSdbEnter (); - fmt = FormatStrings_HandleEscape (fmt); - i = 0; - s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w, _w_high); - s = HandlePercent (fmt, s, i); - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Sprintf2 - returns a string, s, which has been formatted. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - int i; - DynamicStrings_String s; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - DSdbEnter (); - fmt = FormatStrings_HandleEscape (fmt); - i = 0; - s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high); - s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high); - s = HandlePercent (fmt, s, i); - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Sprintf3 - returns a string, s, which has been formatted. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high) -{ - int i; - DynamicStrings_String s; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - - DSdbEnter (); - fmt = FormatStrings_HandleEscape (fmt); - i = 0; - s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high); - s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high); - s = FormatString (fmt, &i, s, (const unsigned char *) w3, _w3_high); - s = HandlePercent (fmt, s, i); - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Sprintf4 - returns a string, s, which has been formatted. -*/ - -extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high) -{ - int i; - DynamicStrings_String s; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - unsigned char w4[_w4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - memcpy (w4, w4_, _w4_high+1); - - DSdbEnter (); - fmt = FormatStrings_HandleEscape (fmt); - i = 0; - s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high); - s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high); - s = FormatString (fmt, &i, s, (const unsigned char *) w3, _w3_high); - s = FormatString (fmt, &i, s, (const unsigned char *) w4, _w4_high); - s = HandlePercent (fmt, s, i); - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - HandleEscape - translates \a, \b, \e, \f, -, \r, \x[hex] \[octal] into - their respective ascii codes. It also converts \[any] into - a single [any] character. -*/ - -extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s) -{ - DynamicStrings_String d; - int i; - int j; - char ch; - unsigned char b; - - DSdbEnter (); - d = DynamicStrings_InitString ((const char *) "", 0); - i = DynamicStrings_Index (s, '\\', 0); - j = 0; - while (i >= 0) - { - if (i > 0) - { - /* initially i might be zero which means the end of the string, which is not what we want. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Slice (s, j, i)); - } - ch = DynamicStrings_char (s, i+1); - if (ch == 'a') - { - /* requires a bell. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_bel))); - } - else if (ch == 'b') - { - /* avoid dangling else. */ - /* requires a backspace. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_bs))); - } - else if (ch == 'e') - { - /* avoid dangling else. */ - /* requires a escape. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_esc))); - } - else if (ch == 'f') - { - /* avoid dangling else. */ - /* requires a formfeed. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_ff))); - } - else if (ch == 'n') - { - /* avoid dangling else. */ - /* requires a newline. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_nl))); - } - else if (ch == 'r') - { - /* avoid dangling else. */ - /* requires a carriage return. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_cr))); - } - else if (ch == 't') - { - /* avoid dangling else. */ - /* requires a tab. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_tab))); - } - else if (ch == 'x') - { - /* avoid dangling else. */ - i += 1; - if (isHex (DynamicStrings_char (s, i+1))) - { - b = (unsigned char ) (toHex (DynamicStrings_char (s, i+1))); - i += 1; - if (isHex (DynamicStrings_char (s, i+1))) - { - b = (unsigned char ) ((((unsigned int ) (b))*0x010)+(toHex (DynamicStrings_char (s, i+1)))); - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar ((char ) (b)))); - } - } - } - else if (isOct (ch)) - { - /* avoid dangling else. */ - b = (unsigned char ) (toOct (ch)); - i += 1; - if (isOct (DynamicStrings_char (s, i+1))) - { - b = (unsigned char ) ((((unsigned int ) (b))*8)+(toOct (DynamicStrings_char (s, i+1)))); - i += 1; - if (isOct (DynamicStrings_char (s, i+1))) - { - b = (unsigned char ) ((((unsigned int ) (b))*8)+(toOct (DynamicStrings_char (s, i+1)))); - } - } - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar ((char ) (b)))); - } - else - { - /* avoid dangling else. */ - /* copy escaped character. */ - d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ch))); - } - i += 2; - j = i; - i = DynamicStrings_Index (s, '\\', (unsigned int ) (i)); - } - /* s := Assign(s, Mark(ConCat(d, Mark(Slice(s, j, 0))))) ; dont Mark(s) in the Slice as we Assign contents */ - s = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), j, 0))); - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_FormatStrings_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_FormatStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GFpuIO.c b/gcc/m2/mc-boot/GFpuIO.c deleted file mode 100644 index 205c27b811e1..000000000000 --- a/gcc/m2/mc-boot/GFpuIO.c +++ /dev/null @@ -1,336 +0,0 @@ -/* do not edit automatically generated by mc from FpuIO. */ -/* FpuIO.mod implements a fixed format input/output for REAL/LONGREAL. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#define _FpuIO_H -#define _FpuIO_C - -# include "GStrIO.h" -# include "GStrLib.h" -# include "GASCII.h" -# include "GDynamicStrings.h" -# include "GStringConvert.h" - -# define MaxLineLength 100 -extern "C" void FpuIO_ReadReal (double *x); - -/* - WriteReal - converts a REAL number, x, which has a, TotalWidth, and - FractionWidth into, string, a. -*/ - -extern "C" void FpuIO_WriteReal (double x, unsigned int TotalWidth, unsigned int FractionWidth); - -/* - WriteReal - converts a REAL number, x, which has a, TotalWidth, and - FractionWidth into, string, a. -*/ - -extern "C" void FpuIO_StrToReal (const char *a_, unsigned int _a_high, double *x); - -/* - RealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_RealToStr (double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high); -extern "C" void FpuIO_ReadLongReal (long double *x); - -/* - WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_WriteLongReal (long double x, unsigned int TotalWidth, unsigned int FractionWidth); - -/* - WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_StrToLongReal (const char *a_, unsigned int _a_high, long double *x); - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_LongRealToStr (long double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high); - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_ReadLongInt (long int *x); - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_WriteLongInt (long int x, unsigned int n); - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_StrToLongInt (const char *a_, unsigned int _a_high, long int *x); - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_LongIntToStr (long int x, unsigned int n, char *a, unsigned int _a_high); - -extern "C" void FpuIO_ReadReal (double *x) -{ - typedef struct ReadReal__T1_a ReadReal__T1; - - struct ReadReal__T1_a { char array[MaxLineLength+1]; }; - ReadReal__T1 a; - - /* -#undef GM2_DEBUG_FPUIO -if defined(GM2_DEBUG_FPUIO) -# define InitString(X) InitStringDB(X, __FILE__, __LINE__) -# define InitStringCharStar(X) InitStringCharStarDB(X, __FILE__, __LINE__) -# define InitStringChar(X) InitStringCharDB(X, __FILE__, __LINE__) -# define Mult(X,Y) MultDB(X, Y, __FILE__, __LINE__) -# define Dup(X) DupDB(X, __FILE__, __LINE__) -# define Slice(X,Y,Z) SliceDB(X, Y, Z, __FILE__, __LINE__) -#endif - */ - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - FpuIO_StrToReal ((const char *) &a.array[0], MaxLineLength, x); -} - - -/* - WriteReal - converts a REAL number, x, which has a, TotalWidth, and - FractionWidth into, string, a. -*/ - -extern "C" void FpuIO_WriteReal (double x, unsigned int TotalWidth, unsigned int FractionWidth) -{ - typedef struct WriteReal__T2_a WriteReal__T2; - - struct WriteReal__T2_a { char array[MaxLineLength+1]; }; - WriteReal__T2 a; - - FpuIO_RealToStr (x, TotalWidth, FractionWidth, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - - -/* - WriteReal - converts a REAL number, x, which has a, TotalWidth, and - FractionWidth into, string, a. -*/ - -extern "C" void FpuIO_StrToReal (const char *a_, unsigned int _a_high, double *x) -{ - long double lr; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - FpuIO_StrToLongReal ((const char *) a, _a_high, &lr); /* let StrToLongReal do the work and we convert the result back to REAL */ - (*x) = (double ) (lr); /* let StrToLongReal do the work and we convert the result back to REAL */ -} - - -/* - RealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_RealToStr (double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high) -{ - long double lr; - - lr = (long double ) (x); - FpuIO_LongRealToStr (lr, TotalWidth, FractionWidth, (char *) a, _a_high); -} - -extern "C" void FpuIO_ReadLongReal (long double *x) -{ - typedef struct ReadLongReal__T3_a ReadLongReal__T3; - - struct ReadLongReal__T3_a { char array[MaxLineLength+1]; }; - ReadLongReal__T3 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - FpuIO_StrToLongReal ((const char *) &a.array[0], MaxLineLength, x); -} - - -/* - WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_WriteLongReal (long double x, unsigned int TotalWidth, unsigned int FractionWidth) -{ - typedef struct WriteLongReal__T4_a WriteLongReal__T4; - - struct WriteLongReal__T4_a { char array[MaxLineLength+1]; }; - WriteLongReal__T4 a; - - FpuIO_LongRealToStr (x, TotalWidth, FractionWidth, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - - -/* - WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_StrToLongReal (const char *a_, unsigned int _a_high, long double *x) -{ - unsigned int found; - DynamicStrings_String s; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - s = DynamicStrings_InitString ((const char *) a, _a_high); - (*x) = StringConvert_StringToLongreal (s, &found); - s = DynamicStrings_KillString (s); -} - - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_LongRealToStr (long double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high) -{ - DynamicStrings_String s; - - s = StringConvert_LongrealToString (x, TotalWidth, FractionWidth); - DynamicStrings_CopyOut ((char *) a, _a_high, s); - s = DynamicStrings_KillString (s); -} - - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_ReadLongInt (long int *x) -{ - typedef struct ReadLongInt__T5_a ReadLongInt__T5; - - struct ReadLongInt__T5_a { char array[MaxLineLength+1]; }; - ReadLongInt__T5 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - FpuIO_StrToLongInt ((const char *) &a.array[0], MaxLineLength, x); -} - - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_WriteLongInt (long int x, unsigned int n) -{ - typedef struct WriteLongInt__T6_a WriteLongInt__T6; - - struct WriteLongInt__T6_a { char array[MaxLineLength+1]; }; - WriteLongInt__T6 a; - - FpuIO_LongIntToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_StrToLongInt (const char *a_, unsigned int _a_high, long int *x) -{ - DynamicStrings_String s; - unsigned int found; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - s = DynamicStrings_InitString ((const char *) a, _a_high); - (*x) = StringConvert_StringToLongInteger (s, 10, &found); - s = DynamicStrings_KillString (s); -} - - -/* - LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and - FractionWidth into a string. -*/ - -extern "C" void FpuIO_LongIntToStr (long int x, unsigned int n, char *a, unsigned int _a_high) -{ - DynamicStrings_String s; - - s = StringConvert_LongIntegerToString (x, n, ' ', FALSE, 10, TRUE); - DynamicStrings_CopyOut ((char *) a, _a_high, s); - s = DynamicStrings_KillString (s); -} - -extern "C" void _M2_FpuIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_FpuIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GIO.c b/gcc/m2/mc-boot/GIO.c deleted file mode 100644 index e56c74382f53..000000000000 --- a/gcc/m2/mc-boot/GIO.c +++ /dev/null @@ -1,479 +0,0 @@ -/* do not edit automatically generated by mc from IO. */ -/* IO.mod provides Read, Write, Errors procedures mapping onto 0, 1 and 2. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#define _IO_H -#define _IO_C - -# include "GStrLib.h" -# include "GSYSTEM.h" -# include "Glibc.h" -# include "GFIO.h" -# include "Gerrno.h" -# include "GASCII.h" -# include "Gtermios.h" - -# define MaxDefaultFd 2 -typedef struct IO_BasicFds_r IO_BasicFds; - -typedef struct IO__T1_a IO__T1; - -struct IO_BasicFds_r { - unsigned int IsEof; - unsigned int IsRaw; - }; - -struct IO__T1_a { IO_BasicFds array[MaxDefaultFd+1]; }; -static IO__T1 fdState; - -/* - IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2. -*/ - -extern "C" void IO_Read (char *ch); - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -extern "C" void IO_Write (char ch); - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -extern "C" void IO_Error (char ch); -extern "C" void IO_UnBufferedMode (int fd, unsigned int input); -extern "C" void IO_BufferedMode (int fd, unsigned int input); - -/* - EchoOn - turns on echoing for file descriptor, fd. This - only really makes sence for a file descriptor opened - for terminal input or maybe some specific file descriptor - which is attached to a particular piece of hardware. -*/ - -extern "C" void IO_EchoOn (int fd, unsigned int input); - -/* - EchoOff - turns off echoing for file descriptor, fd. This - only really makes sence for a file descriptor opened - for terminal input or maybe some specific file descriptor - which is attached to a particular piece of hardware. -*/ - -extern "C" void IO_EchoOff (int fd, unsigned int input); - -/* - IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2. -*/ - -static unsigned int IsDefaultFd (int fd); - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -static void doWrite (int fd, FIO_File f, char ch); - -/* - setFlag - sets or unsets the appropriate flag in, t. -*/ - -static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b); - -/* - doraw - sets all the flags associated with making this - file descriptor into raw input/output. -*/ - -static void doraw (termios_TERMIOS term); - -/* - dononraw - sets all the flags associated with making this - file descriptor into non raw input/output. -*/ - -static void dononraw (termios_TERMIOS term); - -/* - Init - -*/ - -static void Init (void); - - -/* - IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2. -*/ - -static unsigned int IsDefaultFd (int fd) -{ - return (fd <= MaxDefaultFd) && (fd >= 0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -static void doWrite (int fd, FIO_File f, char ch) -{ - int r; - - if (fdState.array[fd].IsRaw) - { - /* avoid dangling else. */ - if (! fdState.array[fd].IsEof) - { - for (;;) - { - r = static_cast (libc_write (FIO_GetUnixFileDescriptor (f), &ch, static_cast (1))); - if (r == 1) - { - return ; - } - else if (r == -1) - { - /* avoid dangling else. */ - r = errno_geterrno (); - if ((r != errno_EAGAIN) && (r != errno_EINTR)) - { - fdState.array[fd].IsEof = TRUE; - return ; - } - } - } - } - } - else - { - FIO_WriteChar (f, ch); - } -} - - -/* - setFlag - sets or unsets the appropriate flag in, t. -*/ - -static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b) -{ - if (termios_SetFlag (t, f, b)) - {} /* empty. */ -} - - -/* - doraw - sets all the flags associated with making this - file descriptor into raw input/output. -*/ - -static void doraw (termios_TERMIOS term) -{ - /* - * from man 3 termios - * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP - * | INLCR | IGNCR | ICRNL | IXON); - * termios_p->c_oflag &= ~OPOST; - * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN); - * termios_p->c_cflag &= ~(CSIZE | PARENB); - * termios_p->c_cflag |= CS8; - */ - setFlag (term, termios_ignbrk, FALSE); - setFlag (term, termios_ibrkint, FALSE); - setFlag (term, termios_iparmrk, FALSE); - setFlag (term, termios_istrip, FALSE); - setFlag (term, termios_inlcr, FALSE); - setFlag (term, termios_igncr, FALSE); - setFlag (term, termios_icrnl, FALSE); - setFlag (term, termios_ixon, FALSE); - setFlag (term, termios_opost, FALSE); - setFlag (term, termios_lecho, FALSE); - setFlag (term, termios_lechonl, FALSE); - setFlag (term, termios_licanon, FALSE); - setFlag (term, termios_lisig, FALSE); - setFlag (term, termios_liexten, FALSE); - setFlag (term, termios_parenb, FALSE); - setFlag (term, termios_cs8, TRUE); -} - - -/* - dononraw - sets all the flags associated with making this - file descriptor into non raw input/output. -*/ - -static void dononraw (termios_TERMIOS term) -{ - /* - * we undo these settings, (although we leave the character size alone) - * - * from man 3 termios - * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP - * | INLCR | IGNCR | ICRNL | IXON); - * termios_p->c_oflag &= ~OPOST; - * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN); - * termios_p->c_cflag &= ~(CSIZE | PARENB); - * termios_p->c_cflag |= CS8; - */ - setFlag (term, termios_ignbrk, TRUE); - setFlag (term, termios_ibrkint, TRUE); - setFlag (term, termios_iparmrk, TRUE); - setFlag (term, termios_istrip, TRUE); - setFlag (term, termios_inlcr, TRUE); - setFlag (term, termios_igncr, TRUE); - setFlag (term, termios_icrnl, TRUE); - setFlag (term, termios_ixon, TRUE); - setFlag (term, termios_opost, TRUE); - setFlag (term, termios_lecho, TRUE); - setFlag (term, termios_lechonl, TRUE); - setFlag (term, termios_licanon, TRUE); - setFlag (term, termios_lisig, TRUE); - setFlag (term, termios_liexten, TRUE); -} - - -/* - Init - -*/ - -static void Init (void) -{ - fdState.array[0].IsEof = FALSE; - fdState.array[0].IsRaw = FALSE; - fdState.array[1].IsEof = FALSE; - fdState.array[1].IsRaw = FALSE; - fdState.array[2].IsEof = FALSE; - fdState.array[2].IsRaw = FALSE; -} - - -/* - IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2. -*/ - -extern "C" void IO_Read (char *ch) -{ - int r; - - FIO_FlushBuffer (FIO_StdOut); - FIO_FlushBuffer (FIO_StdErr); - if (fdState.array[0].IsRaw) - { - if (fdState.array[0].IsEof) - { - (*ch) = ASCII_eof; - } - else - { - for (;;) - { - r = static_cast (libc_read (FIO_GetUnixFileDescriptor (FIO_StdIn), ch, static_cast (1))); - if (r == 1) - { - return ; - } - else if (r == -1) - { - /* avoid dangling else. */ - r = errno_geterrno (); - if (r != errno_EAGAIN) - { - fdState.array[0].IsEof = TRUE; - (*ch) = ASCII_eof; - return ; - } - } - } - } - } - else - { - (*ch) = FIO_ReadChar (FIO_StdIn); - } -} - - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -extern "C" void IO_Write (char ch) -{ - doWrite (1, FIO_StdOut, ch); -} - - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -extern "C" void IO_Error (char ch) -{ - doWrite (2, FIO_StdErr, ch); -} - -extern "C" void IO_UnBufferedMode (int fd, unsigned int input) -{ - termios_TERMIOS term; - int result; - - if (IsDefaultFd (fd)) - { - fdState.array[fd].IsRaw = TRUE; - } - term = termios_InitTermios (); - if ((termios_tcgetattr (fd, term)) == 0) - { - doraw (term); - if (input) - { - result = termios_tcsetattr (fd, termios_tcsflush (), term); - } - else - { - result = termios_tcsetattr (fd, termios_tcsdrain (), term); - } - } - term = termios_KillTermios (term); -} - -extern "C" void IO_BufferedMode (int fd, unsigned int input) -{ - termios_TERMIOS term; - int r; - - if (IsDefaultFd (fd)) - { - fdState.array[fd].IsRaw = FALSE; - } - term = termios_InitTermios (); - if ((termios_tcgetattr (fd, term)) == 0) - { - dononraw (term); - if (input) - { - r = termios_tcsetattr (fd, termios_tcsflush (), term); - } - else - { - r = termios_tcsetattr (fd, termios_tcsdrain (), term); - } - } - term = termios_KillTermios (term); -} - - -/* - EchoOn - turns on echoing for file descriptor, fd. This - only really makes sence for a file descriptor opened - for terminal input or maybe some specific file descriptor - which is attached to a particular piece of hardware. -*/ - -extern "C" void IO_EchoOn (int fd, unsigned int input) -{ - termios_TERMIOS term; - int result; - - term = termios_InitTermios (); - if ((termios_tcgetattr (fd, term)) == 0) - { - setFlag (term, termios_lecho, TRUE); - if (input) - { - result = termios_tcsetattr (fd, termios_tcsflush (), term); - } - else - { - result = termios_tcsetattr (fd, termios_tcsdrain (), term); - } - } - term = termios_KillTermios (term); -} - - -/* - EchoOff - turns off echoing for file descriptor, fd. This - only really makes sence for a file descriptor opened - for terminal input or maybe some specific file descriptor - which is attached to a particular piece of hardware. -*/ - -extern "C" void IO_EchoOff (int fd, unsigned int input) -{ - termios_TERMIOS term; - int result; - - term = termios_InitTermios (); - if ((termios_tcgetattr (fd, term)) == 0) - { - setFlag (term, termios_lecho, FALSE); - if (input) - { - result = termios_tcsetattr (fd, termios_tcsflush (), term); - } - else - { - result = termios_tcsetattr (fd, termios_tcsdrain (), term); - } - } - term = termios_KillTermios (term); -} - -extern "C" void _M2_IO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_IO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GIndexing.c b/gcc/m2/mc-boot/GIndexing.c deleted file mode 100644 index 0817ff36ca25..000000000000 --- a/gcc/m2/mc-boot/GIndexing.c +++ /dev/null @@ -1,491 +0,0 @@ -/* do not edit automatically generated by mc from Indexing. */ -/* Indexing provides a dynamic array of pointers. - Copyright (C) 2015-2023 Free Software Foundation, Inc. - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _Indexing_H -#define _Indexing_C - -# include "Glibc.h" -# include "GStorage.h" -# include "GSYSTEM.h" -# include "GmcDebug.h" -# include "GM2RTS.h" - -typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure; - -# define MinSize 128 -typedef struct Indexing__T2_r Indexing__T2; - -typedef void * *Indexing_PtrToAddress; - -typedef Indexing__T2 *Indexing_Index; - -typedef unsigned char *Indexing_PtrToByte; - -typedef void (*Indexing_IndexProcedure_t) (void *); -struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; }; - -struct Indexing__T2_r { - void *ArrayStart; - unsigned int ArraySize; - unsigned int Used; - unsigned int Low; - unsigned int High; - unsigned int Debug; - unsigned int Map; - }; - - -/* - InitIndex - creates and returns an Index. -*/ - -extern "C" Indexing_Index Indexing_InitIndex (unsigned int low); - -/* - KillIndex - returns Index to free storage. -*/ - -extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i); - -/* - DebugIndex - turns on debugging within an index. -*/ - -extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i); - -/* - InBounds - returns TRUE if indice, n, is within the bounds - of the dynamic array. -*/ - -extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n); - -/* - HighIndice - returns the last legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_HighIndice (Indexing_Index i); - -/* - LowIndice - returns the first legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_LowIndice (Indexing_Index i); - -/* - PutIndice - places, a, into the dynamic array at position i[n] -*/ - -extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a); - -/* - GetIndice - retrieves, element i[n] from the dynamic array. -*/ - -extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n); - -/* - IsIndiceInIndex - returns TRUE if, a, is in the index, i. -*/ - -extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a); - -/* - RemoveIndiceFromIndex - removes, a, from Index, i. -*/ - -extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a); - -/* - DeleteIndice - delete i[j] from the array. -*/ - -extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j); - -/* - IncludeIndiceIntoIndex - if the indice is not in the index, then - add it at the end. -*/ - -extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a); - -/* - ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j]) -*/ - -extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p); - - -/* - InitIndex - creates and returns an Index. -*/ - -extern "C" Indexing_Index Indexing_InitIndex (unsigned int low) -{ - Indexing_Index i; - - Storage_ALLOCATE ((void **) &i, sizeof (Indexing__T2)); - i->Low = low; - i->High = 0; - i->ArraySize = MinSize; - Storage_ALLOCATE (&i->ArrayStart, MinSize); - i->ArrayStart = libc_memset (i->ArrayStart, 0, static_cast (i->ArraySize)); - i->Debug = FALSE; - i->Used = 0; - i->Map = (unsigned int) 0; - return i; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillIndex - returns Index to free storage. -*/ - -extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i) -{ - Storage_DEALLOCATE (&i->ArrayStart, i->ArraySize); - Storage_DEALLOCATE ((void **) &i, sizeof (Indexing__T2)); - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DebugIndex - turns on debugging within an index. -*/ - -extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i) -{ - i->Debug = TRUE; - return i; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InBounds - returns TRUE if indice, n, is within the bounds - of the dynamic array. -*/ - -extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n) -{ - if (i == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return (n >= i->Low) && (n <= i->High); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1); - __builtin_unreachable (); -} - - -/* - HighIndice - returns the last legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_HighIndice (Indexing_Index i) -{ - if (i == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return i->High; - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1); - __builtin_unreachable (); -} - - -/* - LowIndice - returns the first legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_LowIndice (Indexing_Index i) -{ - if (i == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return i->Low; - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1); - __builtin_unreachable (); -} - - -/* - PutIndice - places, a, into the dynamic array at position i[n] -*/ - -extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a) -{ - typedef unsigned int * *PutIndice__T1; - - unsigned int oldSize; - void * b; - PutIndice__T1 p; - - if (! (Indexing_InBounds (i, n))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (n < i->Low) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - oldSize = i->ArraySize; - while (((n-i->Low)*sizeof (void *)) >= i->ArraySize) - { - i->ArraySize = i->ArraySize*2; - } - if (oldSize != i->ArraySize) - { - /* - IF Debug - THEN - printf2('increasing memory hunk from %d to %d - ', - oldSize, ArraySize) - END ; - */ - Storage_REALLOCATE (&i->ArrayStart, i->ArraySize); - /* and initialize the remainder of the array to NIL */ - b = i->ArrayStart; - b = reinterpret_cast (reinterpret_cast (b)+oldSize); - b = libc_memset (b, 0, static_cast (i->ArraySize-oldSize)); - } - i->High = n; - } - } - b = i->ArrayStart; - b = reinterpret_cast (reinterpret_cast (b)+(n-i->Low)*sizeof (void *)); - p = static_cast (b); - (*p) = reinterpret_cast (a); - i->Used += 1; - if (i->Debug) - { - if (n < 32) - { - i->Map |= (1 << (n )); - } - } -} - - -/* - GetIndice - retrieves, element i[n] from the dynamic array. -*/ - -extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n) -{ - Indexing_PtrToByte b; - Indexing_PtrToAddress p; - - if (! (Indexing_InBounds (i, n))) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - b = static_cast (i->ArrayStart); - b += (n-i->Low)*sizeof (void *); - p = (Indexing_PtrToAddress) (b); - if (i->Debug) - { - if (((n < 32) && (! ((((1 << (n)) & (i->Map)) != 0)))) && ((*p) != NULL)) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - return (*p); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsIndiceInIndex - returns TRUE if, a, is in the index, i. -*/ - -extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a) -{ - unsigned int j; - Indexing_PtrToByte b; - Indexing_PtrToAddress p; - - j = i->Low; - b = static_cast (i->ArrayStart); - while (j <= i->High) - { - p = (Indexing_PtrToAddress) (b); - if ((*p) == a) - { - return TRUE; - } - /* we must not INC(p, ..) as p2c gets confused */ - b += sizeof (void *); - j += 1; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveIndiceFromIndex - removes, a, from Index, i. -*/ - -extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a) -{ - unsigned int j; - unsigned int k; - Indexing_PtrToAddress p; - Indexing_PtrToByte b; - - j = i->Low; - b = static_cast (i->ArrayStart); - while (j <= i->High) - { - p = (Indexing_PtrToAddress) (b); - b += sizeof (void *); - if ((*p) == a) - { - Indexing_DeleteIndice (i, j); - } - j += 1; - } -} - - -/* - DeleteIndice - delete i[j] from the array. -*/ - -extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j) -{ - Indexing_PtrToAddress p; - Indexing_PtrToByte b; - - if (Indexing_InBounds (i, j)) - { - b = static_cast (i->ArrayStart); - b += sizeof (void *)*(j-i->Low); - p = (Indexing_PtrToAddress) (b); - b += sizeof (void *); - p = static_cast (libc_memmove (reinterpret_cast (p), reinterpret_cast (b), static_cast ((i->High-j)*sizeof (void *)))); - i->High -= 1; - i->Used -= 1; - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - IncludeIndiceIntoIndex - if the indice is not in the index, then - add it at the end. -*/ - -extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a) -{ - if (! (Indexing_IsIndiceInIndex (i, a))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (i->Used == 0) - { - Indexing_PutIndice (i, Indexing_LowIndice (i), a); - } - else - { - Indexing_PutIndice (i, (Indexing_HighIndice (i))+1, a); - } - } -} - - -/* - ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j]) -*/ - -extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p) -{ - unsigned int j; - Indexing_IndexProcedure q; - - j = Indexing_LowIndice (i); - q = p; - while (j <= (Indexing_HighIndice (i))) - { - mcDebug_assert (q.proc == p.proc); - (*p.proc) (Indexing_GetIndice (i, j)); - j += 1; - } -} - -extern "C" void _M2_Indexing_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Indexing_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GM2Dependent.c b/gcc/m2/mc-boot/GM2Dependent.c deleted file mode 100644 index 64441fff6429..000000000000 --- a/gcc/m2/mc-boot/GM2Dependent.c +++ /dev/null @@ -1,1407 +0,0 @@ -/* do not edit automatically generated by mc from M2Dependent. */ -/* M2Dependent.mod implements the run time module dependencies. - -Copyright (C) 2022-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _M2Dependent_H -#define _M2Dependent_C - -# include "Glibc.h" -# include "GM2LINK.h" -# include "GASCII.h" -# include "GSYSTEM.h" -# include "GStorage.h" -# include "GStrLib.h" -# include "GM2RTS.h" - -typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP; - -typedef struct M2Dependent_DependencyList_r M2Dependent_DependencyList; - -typedef struct M2Dependent__T2_r M2Dependent__T2; - -typedef M2Dependent__T2 *M2Dependent_ModuleChain; - -typedef struct M2Dependent__T3_a M2Dependent__T3; - -typedef enum {M2Dependent_unregistered, M2Dependent_unordered, M2Dependent_started, M2Dependent_ordered, M2Dependent_user} M2Dependent_DependencyState; - -typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *); -struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; }; - -struct M2Dependent_DependencyList_r { - PROC proc; - unsigned int forced; - unsigned int forc; - unsigned int appl; - M2Dependent_DependencyState state; - }; - -struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; }; -struct M2Dependent__T2_r { - void *name; - void *libname; - M2Dependent_ArgCVEnvP init; - M2Dependent_ArgCVEnvP fini; - M2Dependent_DependencyList dependency; - M2Dependent_ModuleChain prev; - M2Dependent_ModuleChain next; - }; - -static M2Dependent__T3 Modules; -static unsigned int Initialized; -static unsigned int WarningTrace; -static unsigned int ModuleTrace; -static unsigned int HexTrace; -static unsigned int DependencyTrace; -static unsigned int PreTrace; -static unsigned int PostTrace; -static unsigned int ForceTrace; - -/* - ConstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); - -/* - DeconstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); - -/* - RegisterModule - adds module name to the list of outstanding - modules which need to have their dependencies - explored to determine initialization order. -*/ - -extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies); - -/* - RequestDependant - used to specify that modulename is dependant upon - module dependantmodule. It only takes effect - if we are not using StaticInitialization. -*/ - -extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname); - -/* - CreateModule - creates a new module entry and returns the - ModuleChain. -*/ - -static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies); - -/* - AppendModule - append chain to end of the list. -*/ - -static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain); - -/* - RemoveModule - remove chain from double linked list head. -*/ - -static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain); - -/* - onChain - returns TRUE if mptr is on the Modules[state] list. -*/ - -static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr); - -/* - max - -*/ - -static unsigned int max (unsigned int a, unsigned int b); - -/* - min - -*/ - -static unsigned int min (unsigned int a, unsigned int b); - -/* - LookupModuleN - lookup module from the state list. - The strings lengths are known. -*/ - -static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen); - -/* - LookupModule - lookup and return the ModuleChain pointer containing - module name from a particular list. -*/ - -static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname); - -/* - toCString - replace any character sequence - into a newline. -*/ - -static void toCString (char *str, unsigned int _str_high); - -/* - strcmp - return 0 if both strings are equal. - We cannot use Builtins.def during bootstrap. -*/ - -static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b); - -/* - strncmp - return 0 if both strings are equal. - We cannot use Builtins.def during bootstrap. -*/ - -static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n); - -/* - strlen - returns the length of string. -*/ - -static int strlen_ (M2LINK_PtrToChar string); - -/* - traceprintf - wrap printf with a boolean flag. -*/ - -static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high); - -/* - traceprintf2 - wrap printf with a boolean flag. -*/ - -static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg); - -/* - traceprintf3 - wrap printf with a boolean flag. -*/ - -static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2); - -/* - moveTo - moves mptr to the new list determined by newstate. - It updates the mptr state appropriately. -*/ - -static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr); - -/* - ResolveDependant - -*/ - -static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname); - -/* - PerformRequestDependant - the current modulename has a dependancy upon - dependantmodule. If dependantmodule is NIL then - modulename has no further dependants and it can be - resolved. -*/ - -static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname); - -/* - ResolveDependencies - resolve dependencies for currentmodule, libname. -*/ - -static void ResolveDependencies (void * currentmodule, void * libname); - -/* - DisplayModuleInfo - displays all module in the state. -*/ - -static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high); - -/* - DumpModuleData - -*/ - -static void DumpModuleData (unsigned int flag); - -/* - combine - dest := src + dest. Places src at the front of list dest. - Pre condition: src, dest are lists. - Post condition : dest := src + dest - src := NIL. -*/ - -static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest); - -/* - tracemodule - -*/ - -static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen); - -/* - ForceModule - -*/ - -static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen); - -/* - ForceDependencies - if the user has specified a forced order then we override - the dynamic ordering with the preference. -*/ - -static void ForceDependencies (void); - -/* - CheckApplication - check to see that the application is the last entry in the list. - This might happen if the application only imports FOR C modules. -*/ - -static void CheckApplication (void); - -/* - warning3 - write format arg1 arg2 to stderr. -*/ - -static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2); - -/* - equal - return TRUE if C string cstr is equal to str. -*/ - -static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high); - -/* - SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace, - DumpPostInit to FALSE. It checks the environment - GCC_M2LINK_RTFLAG which can contain - "all,module,hex,pre,post,dep,force". all turns them all on. - The flag meanings are as follows and flags the are in - execution order. - - module generate trace info as the modules are registered. - hex dump the modules ctor functions address in hex. - pre generate a list of all modules seen prior to having - their dependancies resolved. - dep display a trace as the modules are resolved. - post generate a list of all modules seen after having - their dependancies resolved dynamically. - force generate a list of all modules seen after having - their dependancies resolved and forced. -*/ - -static void SetupDebugFlags (void); - -/* - Init - initialize the debug flags and set all lists to NIL. -*/ - -static void Init (void); - -/* - CheckInitialized - checks to see if this module has been initialized - and if it has not it calls Init. We need this - approach as this module is called by module ctors - before we reach main. -*/ - -static void CheckInitialized (void); - - -/* - CreateModule - creates a new module entry and returns the - ModuleChain. -*/ - -static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies) -{ - M2Dependent_ModuleChain mptr; - void * p0; - void * p1; - - Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2)); - mptr->name = name; - mptr->libname = libname; - mptr->init = init; - mptr->fini = fini; - mptr->dependency.proc = dependencies; - mptr->dependency.state = M2Dependent_unregistered; - mptr->prev = NULL; - mptr->next = NULL; - if (HexTrace) - { - libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini); - libc_printf ((const char *) " dep: %p)", 10, dependencies); - } - return mptr; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - AppendModule - append chain to end of the list. -*/ - -static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain) -{ - if ((*head) == NULL) - { - (*head) = chain; - chain->prev = chain; - chain->next = chain; - } - else - { - chain->next = (*head); /* Add Item to the end of list. */ - chain->prev = (*head)->prev; /* Add Item to the end of list. */ - (*head)->prev->next = chain; - (*head)->prev = chain; - } -} - - -/* - RemoveModule - remove chain from double linked list head. -*/ - -static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain) -{ - if ((chain->next == (*head)) && (chain == (*head))) - { - (*head) = NULL; - } - else - { - if ((*head) == chain) - { - (*head) = (*head)->next; - } - chain->prev->next = chain->next; - chain->next->prev = chain->prev; - } -} - - -/* - onChain - returns TRUE if mptr is on the Modules[state] list. -*/ - -static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr) -{ - M2Dependent_ModuleChain ptr; - - if (Modules.array[state-M2Dependent_unregistered] != NULL) - { - ptr = Modules.array[state-M2Dependent_unregistered]; - do { - if (ptr == mptr) - { - return TRUE; - } - ptr = ptr->next; - } while (! (ptr == Modules.array[state-M2Dependent_unregistered])); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - max - -*/ - -static unsigned int max (unsigned int a, unsigned int b) -{ - if (a > b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - min - -*/ - -static unsigned int min (unsigned int a, unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - LookupModuleN - lookup module from the state list. - The strings lengths are known. -*/ - -static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen) -{ - M2Dependent_ModuleChain ptr; - - if (Modules.array[state-M2Dependent_unregistered] != NULL) - { - ptr = Modules.array[state-M2Dependent_unregistered]; - do { - if (((strncmp (reinterpret_cast (ptr->name), reinterpret_cast (name), max (namelen, static_cast (strlen_ (reinterpret_cast (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast (ptr->libname), reinterpret_cast (libname), max (libnamelen, static_cast (strlen_ (reinterpret_cast (ptr->libname)))))) == 0)) - { - return ptr; - } - ptr = ptr->next; - } while (! (ptr == Modules.array[state-M2Dependent_unregistered])); - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - LookupModule - lookup and return the ModuleChain pointer containing - module name from a particular list. -*/ - -static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname) -{ - return LookupModuleN (state, name, static_cast (strlen_ (reinterpret_cast (name))), libname, static_cast (strlen_ (reinterpret_cast (libname)))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - toCString - replace any character sequence - into a newline. -*/ - -static void toCString (char *str, unsigned int _str_high) -{ - unsigned int high; - unsigned int i; - unsigned int j; - - i = 0; - high = _str_high; - while (i < high) - { - if ((i < high) && (str[i] == '\\')) - { - if (str[i+1] == 'n') - { - str[i] = ASCII_nl; - j = i+1; - while (j < high) - { - str[j] = str[j+1]; - j += 1; - } - } - } - i += 1; - } -} - - -/* - strcmp - return 0 if both strings are equal. - We cannot use Builtins.def during bootstrap. -*/ - -static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b) -{ - if ((a != NULL) && (b != NULL)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (a == b) - { - return 0; - } - else - { - while ((*a) == (*b)) - { - if ((*a) == ASCII_nul) - { - return 0; - } - a += 1; - b += 1; - } - } - } - return 1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - strncmp - return 0 if both strings are equal. - We cannot use Builtins.def during bootstrap. -*/ - -static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n) -{ - if (n == 0) - { - return 0; - } - else if ((a != NULL) && (b != NULL)) - { - /* avoid dangling else. */ - if (a == b) - { - return 0; - } - else - { - while (((*a) == (*b)) && (n > 0)) - { - if (((*a) == ASCII_nul) || (n == 1)) - { - return 0; - } - a += 1; - b += 1; - n -= 1; - } - } - } - return 1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - strlen - returns the length of string. -*/ - -static int strlen_ (M2LINK_PtrToChar string) -{ - int count; - - if (string == NULL) - { - return 0; - } - else - { - count = 0; - while ((*string) != ASCII_nul) - { - string += 1; - count += 1; - } - return count; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - traceprintf - wrap printf with a boolean flag. -*/ - -static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high) -{ - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - if (flag) - { - toCString ((char *) str, _str_high); - libc_printf ((const char *) str, _str_high); - } -} - - -/* - traceprintf2 - wrap printf with a boolean flag. -*/ - -static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg) -{ - char ch; - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - if (flag) - { - toCString ((char *) str, _str_high); - if (arg == NULL) - { - ch = (char) 0; - arg = &ch; - } - libc_printf ((const char *) str, _str_high, arg); - } -} - - -/* - traceprintf3 - wrap printf with a boolean flag. -*/ - -static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2) -{ - char ch; - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - if (flag) - { - toCString ((char *) str, _str_high); - if (arg1 == NULL) - { - ch = (char) 0; - arg1 = &ch; - } - if (arg2 == NULL) - { - ch = (char) 0; - arg2 = &ch; - } - libc_printf ((const char *) str, _str_high, arg1, arg2); - } -} - - -/* - moveTo - moves mptr to the new list determined by newstate. - It updates the mptr state appropriately. -*/ - -static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr) -{ - if (onChain (mptr->dependency.state, mptr)) - { - RemoveModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr); - } - mptr->dependency.state = newstate; - AppendModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr); -} - - -/* - ResolveDependant - -*/ - -static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname) -{ - if (mptr == NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname); - } - else - { - if (onChain (M2Dependent_started, mptr)) - { - traceprintf (DependencyTrace, (const char *) " processing...\\n", 18); - } - else - { - moveTo (M2Dependent_started, mptr); - traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname); - (*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */ - traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */ - moveTo (M2Dependent_ordered, mptr); - } - } -} - - -/* - PerformRequestDependant - the current modulename has a dependancy upon - dependantmodule. If dependantmodule is NIL then - modulename has no further dependants and it can be - resolved. -*/ - -static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname) -{ - M2Dependent_ModuleChain mptr; - - traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname); - if (dependantmodule == NULL) - { - /* avoid dangling else. */ - traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32); - mptr = LookupModule (M2Dependent_unordered, modulename, libname); - if (mptr != NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname); - moveTo (M2Dependent_ordered, mptr); - } - } - else - { - traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname); - mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname); - if (mptr == NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname); - mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname); - if (mptr == NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname); - mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname); - if (mptr == NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname); - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname); - traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname); - } - else - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname); - } - } - else - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname); - ResolveDependant (mptr, dependantmodule, dependantlibname); - } - } - else - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname); - traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname); - } - } -} - - -/* - ResolveDependencies - resolve dependencies for currentmodule, libname. -*/ - -static void ResolveDependencies (void * currentmodule, void * libname) -{ - M2Dependent_ModuleChain mptr; - - mptr = LookupModule (M2Dependent_unordered, currentmodule, libname); - while (mptr != NULL) - { - traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname); - ResolveDependant (mptr, currentmodule, libname); - mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered]; - } -} - - -/* - DisplayModuleInfo - displays all module in the state. -*/ - -static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high) -{ - M2Dependent_ModuleChain mptr; - unsigned int count; - char desc[_desc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (desc, desc_, _desc_high+1); - - if (Modules.array[state-M2Dependent_unregistered] != NULL) - { - libc_printf ((const char *) "%s modules\\n", 12, &desc); - mptr = Modules.array[state-M2Dependent_unregistered]; - count = 0; - do { - if (mptr->name == NULL) - { - libc_printf ((const char *) " %d %s []", 11, count, mptr->name); - } - else - { - libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname); - } - count += 1; - if (mptr->dependency.appl) - { - libc_printf ((const char *) " application", 12); - } - if (mptr->dependency.forc) - { - libc_printf ((const char *) " for C", 6); - } - if (mptr->dependency.forced) - { - libc_printf ((const char *) " forced ordering", 16); - } - libc_printf ((const char *) "\\n", 2); - mptr = mptr->next; - } while (! (mptr == Modules.array[state-M2Dependent_unregistered])); - } -} - - -/* - DumpModuleData - -*/ - -static void DumpModuleData (unsigned int flag) -{ - M2Dependent_ModuleChain mptr; - - if (flag) - { - DisplayModuleInfo (M2Dependent_unregistered, (const char *) "unregistered", 12); - DisplayModuleInfo (M2Dependent_unordered, (const char *) "unordered", 9); - DisplayModuleInfo (M2Dependent_started, (const char *) "started", 7); - DisplayModuleInfo (M2Dependent_ordered, (const char *) "ordered", 7); - } -} - - -/* - combine - dest := src + dest. Places src at the front of list dest. - Pre condition: src, dest are lists. - Post condition : dest := src + dest - src := NIL. -*/ - -static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest) -{ - M2Dependent_ModuleChain last; - - while (Modules.array[src-M2Dependent_unregistered] != NULL) - { - last = Modules.array[src-M2Dependent_unregistered]->prev; - moveTo (M2Dependent_ordered, last); - Modules.array[dest-M2Dependent_unregistered] = last; /* New item is at the head. */ - } -} - - -/* - tracemodule - -*/ - -static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen) -{ - typedef struct tracemodule__T4_a tracemodule__T4; - - struct tracemodule__T4_a { char array[100+1]; }; - tracemodule__T4 buffer; - unsigned int len; - - if (flag) - { - len = min (modlen, sizeof (buffer)-1); - libc_strncpy (&buffer, modname, len); - buffer.array[len] = (char) 0; - libc_printf ((const char *) "%s ", 3, &buffer); - len = min (liblen, sizeof (buffer)-1); - libc_strncpy (&buffer, libname, len); - buffer.array[len] = (char) 0; - libc_printf ((const char *) " [%s]", 5, &buffer); - } -} - - -/* - ForceModule - -*/ - -static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen) -{ - M2Dependent_ModuleChain mptr; - - traceprintf (ForceTrace, (const char *) "forcing module: ", 16); - tracemodule (ForceTrace, modname, modlen, libname, liblen); - traceprintf (ForceTrace, (const char *) "\\n", 2); - mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen); - if (mptr != NULL) - { - mptr->dependency.forced = TRUE; - moveTo (M2Dependent_user, mptr); - } -} - - -/* - ForceDependencies - if the user has specified a forced order then we override - the dynamic ordering with the preference. -*/ - -static void ForceDependencies (void) -{ - unsigned int len; - unsigned int modlen; - unsigned int liblen; - M2LINK_PtrToChar modname; - M2LINK_PtrToChar libname; - M2LINK_PtrToChar pc; - M2LINK_PtrToChar start; - - if (M2LINK_ForcedModuleInitOrder != NULL) - { - traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast (M2LINK_ForcedModuleInitOrder)); - pc = M2LINK_ForcedModuleInitOrder; - start = pc; - len = 0; - modname = NULL; - modlen = 0; - libname = NULL; - liblen = 0; - while ((*pc) != ASCII_nul) - { - switch ((*pc)) - { - case ':': - libname = start; - liblen = len; - len = 0; - pc += 1; - start = pc; - break; - - case ',': - modname = start; - modlen = len; - ForceModule (reinterpret_cast (modname), modlen, reinterpret_cast (libname), liblen); - libname = NULL; - liblen = 0; - modlen = 0; - len = 0; - pc += 1; - start = pc; - break; - - - default: - pc += 1; - len += 1; - break; - } - } - if (start != pc) - { - ForceModule (reinterpret_cast (start), len, reinterpret_cast (libname), liblen); - } - combine (M2Dependent_user, M2Dependent_ordered); - } -} - - -/* - CheckApplication - check to see that the application is the last entry in the list. - This might happen if the application only imports FOR C modules. -*/ - -static void CheckApplication (void) -{ - M2Dependent_ModuleChain mptr; - M2Dependent_ModuleChain appl; - - mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]; - if (mptr != NULL) - { - appl = NULL; - do { - if (mptr->dependency.appl) - { - appl = mptr; - } - else - { - mptr = mptr->next; - } - } while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]))); - if (appl != NULL) - { - RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl); - AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl); - } - } -} - - -/* - warning3 - write format arg1 arg2 to stderr. -*/ - -static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2) -{ - typedef struct warning3__T5_a warning3__T5; - - struct warning3__T5_a { char array[4096+1]; }; - warning3__T5 buffer; - int len; - char format[_format_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (format, format_, _format_high+1); - - if (WarningTrace) - { - len = libc_snprintf (&buffer, static_cast (sizeof (buffer)), (const char *) "warning: ", 9); - libc_write (2, &buffer, static_cast (len)); - len = libc_snprintf (&buffer, static_cast (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2); - libc_write (2, &buffer, static_cast (len)); - } -} - - -/* - equal - return TRUE if C string cstr is equal to str. -*/ - -static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high) -{ - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - return (strncmp (reinterpret_cast (cstr), reinterpret_cast (&str), StrLib_StrLen ((const char *) str, _str_high))) == 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace, - DumpPostInit to FALSE. It checks the environment - GCC_M2LINK_RTFLAG which can contain - "all,module,hex,pre,post,dep,force". all turns them all on. - The flag meanings are as follows and flags the are in - execution order. - - module generate trace info as the modules are registered. - hex dump the modules ctor functions address in hex. - pre generate a list of all modules seen prior to having - their dependancies resolved. - dep display a trace as the modules are resolved. - post generate a list of all modules seen after having - their dependancies resolved dynamically. - force generate a list of all modules seen after having - their dependancies resolved and forced. -*/ - -static void SetupDebugFlags (void) -{ - typedef char *SetupDebugFlags__T1; - - SetupDebugFlags__T1 pc; - - ModuleTrace = FALSE; - DependencyTrace = FALSE; - PostTrace = FALSE; - PreTrace = FALSE; - ForceTrace = FALSE; - HexTrace = FALSE; - WarningTrace = FALSE; - pc = static_cast (libc_getenv (const_cast (reinterpret_cast("GCC_M2LINK_RTFLAG")))); - while ((pc != NULL) && ((*pc) != ASCII_nul)) - { - if (equal (reinterpret_cast (pc), (const char *) "all", 3)) - { - ModuleTrace = TRUE; - DependencyTrace = TRUE; - PreTrace = TRUE; - PostTrace = TRUE; - ForceTrace = TRUE; - HexTrace = TRUE; - WarningTrace = TRUE; - pc += 3; - } - else if (equal (reinterpret_cast (pc), (const char *) "module", 6)) - { - /* avoid dangling else. */ - ModuleTrace = TRUE; - pc += 6; - } - else if (equal (reinterpret_cast (pc), (const char *) "warning", 7)) - { - /* avoid dangling else. */ - WarningTrace = TRUE; - pc += 7; - } - else if (equal (reinterpret_cast (pc), (const char *) "hex", 3)) - { - /* avoid dangling else. */ - HexTrace = TRUE; - pc += 3; - } - else if (equal (reinterpret_cast (pc), (const char *) "dep", 3)) - { - /* avoid dangling else. */ - DependencyTrace = TRUE; - pc += 3; - } - else if (equal (reinterpret_cast (pc), (const char *) "pre", 3)) - { - /* avoid dangling else. */ - PreTrace = TRUE; - pc += 3; - } - else if (equal (reinterpret_cast (pc), (const char *) "post", 4)) - { - /* avoid dangling else. */ - PostTrace = TRUE; - pc += 4; - } - else if (equal (reinterpret_cast (pc), (const char *) "force", 5)) - { - /* avoid dangling else. */ - ForceTrace = TRUE; - pc += 5; - } - else - { - /* avoid dangling else. */ - pc += 1; - } - } -} - - -/* - Init - initialize the debug flags and set all lists to NIL. -*/ - -static void Init (void) -{ - M2Dependent_DependencyState state; - - SetupDebugFlags (); - for (state=M2Dependent_unregistered; state<=M2Dependent_user; state= static_cast(static_cast(state+1))) - { - Modules.array[state-M2Dependent_unregistered] = NULL; - } -} - - -/* - CheckInitialized - checks to see if this module has been initialized - and if it has not it calls Init. We need this - approach as this module is called by module ctors - before we reach main. -*/ - -static void CheckInitialized (void) -{ - if (! Initialized) - { - Initialized = TRUE; - Init (); - } -} - - -/* - ConstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp) -{ - M2Dependent_ModuleChain mptr; - M2Dependent_ArgCVEnvP nulp; - - CheckInitialized (); - traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname); - mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname); - if (mptr != NULL) - { - mptr->dependency.appl = TRUE; - } - traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26); - DumpModuleData (PreTrace); - ResolveDependencies (applicationmodule, libname); - traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27); - DumpModuleData (PostTrace); - ForceDependencies (); - traceprintf (ForceTrace, (const char *) "After user forcing ordering\\n", 29); - DumpModuleData (ForceTrace); - CheckApplication (); - traceprintf (ForceTrace, (const char *) "After runtime forces application to the end\\n", 45); - DumpModuleData (ForceTrace); - if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL) - { - traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname); - traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule); - traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule); - } - else - { - mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]; - do { - if (mptr->dependency.forc) - { - traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname); - } - else - { - traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname); - } - if (mptr->dependency.appl) - { - traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname); - traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42); - M2RTS_ExecuteInitialProcedures (); - traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30); - } - (*mptr->init.proc) (argc, argv, envp); - mptr = mptr->next; - } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])); - } -} - - -/* - DeconstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp) -{ - M2Dependent_ModuleChain mptr; - - traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname); - if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL) - { - traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45); - } - else - { - traceprintf (ModuleTrace, (const char *) "ExecuteTerminationProcedures\\n", 30); - M2RTS_ExecuteTerminationProcedures (); - traceprintf (ModuleTrace, (const char *) "terminating modules in sequence\\n", 33); - mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev; - do { - if (mptr->dependency.forc) - { - traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname); - } - else - { - traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname); - } - (*mptr->fini.proc) (argc, argv, envp); - mptr = mptr->prev; - } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev)); - } -} - - -/* - RegisterModule - adds module name to the list of outstanding - modules which need to have their dependencies - explored to determine initialization order. -*/ - -extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies) -{ - M2Dependent_ModuleChain mptr; - - CheckInitialized (); - if (! M2LINK_StaticInitialization) - { - mptr = LookupModule (M2Dependent_unordered, modulename, libname); - if (mptr == NULL) - { - traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname); - moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies)); - traceprintf (ModuleTrace, (const char *) "\\n", 2); - } - else - { - warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname); - } - } -} - - -/* - RequestDependant - used to specify that modulename is dependant upon - module dependantmodule. It only takes effect - if we are not using StaticInitialization. -*/ - -extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname) -{ - CheckInitialized (); - if (! M2LINK_StaticInitialization) - { - PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname); - } -} - -extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - CheckInitialized (); -} - -extern "C" void _M2_M2Dependent_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GM2EXCEPTION.c b/gcc/m2/mc-boot/GM2EXCEPTION.c deleted file mode 100644 index 387b04764624..000000000000 --- a/gcc/m2/mc-boot/GM2EXCEPTION.c +++ /dev/null @@ -1,89 +0,0 @@ -/* do not edit automatically generated by mc from M2EXCEPTION. */ -/* M2EXCEPTION.mod implement M2Exception and IsM2Exception. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# include "Gmcrts.h" -#define _M2EXCEPTION_H -#define _M2EXCEPTION_C - -# include "GSYSTEM.h" -# include "GRTExceptions.h" - -typedef enum {M2EXCEPTION_indexException, M2EXCEPTION_rangeException, M2EXCEPTION_caseSelectException, M2EXCEPTION_invalidLocation, M2EXCEPTION_functionException, M2EXCEPTION_wholeValueException, M2EXCEPTION_wholeDivException, M2EXCEPTION_realValueException, M2EXCEPTION_realDivException, M2EXCEPTION_complexValueException, M2EXCEPTION_complexDivException, M2EXCEPTION_protException, M2EXCEPTION_sysException, M2EXCEPTION_coException, M2EXCEPTION_exException} M2EXCEPTION_M2Exceptions; - -extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void); -extern "C" unsigned int M2EXCEPTION_IsM2Exception (void); - -extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void) -{ - RTExceptions_EHBlock e; - unsigned int n; - - /* If the program or coroutine is in the exception state then return the enumeration - value representing the exception cause. If it is not in the exception state then - raises and exception (exException). */ - e = RTExceptions_GetExceptionBlock (); - n = RTExceptions_GetNumber (e); - if (n == (UINT_MAX)) - { - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast (reinterpret_cast("M2Exception")), const_cast (reinterpret_cast("current coroutine is not in the exceptional execution state"))); - } - else - { - return (M2EXCEPTION_M2Exceptions) (n); - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1); - __builtin_unreachable (); -} - -extern "C" unsigned int M2EXCEPTION_IsM2Exception (void) -{ - RTExceptions_EHBlock e; - - /* Returns TRUE if the program or coroutine is in the exception state. - Returns FALSE if the program or coroutine is not in the exception state. */ - e = RTExceptions_GetExceptionBlock (); - return (RTExceptions_GetNumber (e)) != (UINT_MAX); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_M2EXCEPTION_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - RTExceptions_SetExceptionBlock (RTExceptions_InitExceptionBlock ()); -} - -extern "C" void _M2_M2EXCEPTION_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GM2RTS.c b/gcc/m2/mc-boot/GM2RTS.c deleted file mode 100644 index 2e8680ccb960..000000000000 --- a/gcc/m2/mc-boot/GM2RTS.c +++ /dev/null @@ -1,819 +0,0 @@ -/* do not edit automatically generated by mc from M2RTS. */ -/* M2RTS.mod Implements the run time system facilities of Modula-2. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _M2RTS_H -#define _M2RTS_C - -# include "Glibc.h" -# include "GNumberIO.h" -# include "GStrLib.h" -# include "GSYSTEM.h" -# include "GASCII.h" -# include "GStorage.h" -# include "GRTExceptions.h" -# include "GM2EXCEPTION.h" -# include "GM2Dependent.h" - -typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP; - -# define stderrFd 2 -typedef struct M2RTS_ProcedureList_r M2RTS_ProcedureList; - -typedef char *M2RTS_PtrToChar; - -typedef struct M2RTS__T1_r M2RTS__T1; - -typedef M2RTS__T1 *M2RTS_ProcedureChain; - -typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *); -struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; }; - -struct M2RTS_ProcedureList_r { - M2RTS_ProcedureChain head; - M2RTS_ProcedureChain tail; - }; - -struct M2RTS__T1_r { - PROC p; - M2RTS_ProcedureChain prev; - M2RTS_ProcedureChain next; - }; - -static M2RTS_ProcedureList InitialProc; -static M2RTS_ProcedureList TerminateProc; -static int ExitValue; -static unsigned int isHalting; -static unsigned int CallExit; -static unsigned int Initialized; - -/* - ConstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); - -/* - DeconstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); - -/* - RegisterModule - adds module name to the list of outstanding - modules which need to have their dependencies - explored to determine initialization order. -*/ - -extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies); - -/* - RequestDependant - used to specify that modulename is dependant upon - module dependantmodule. -*/ - -extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname); - -/* - InstallTerminationProcedure - installs a procedure, p, which will - be called when the procedure - ExecuteTerminationProcedures - is invoked. It returns TRUE if the - procedure is installed. -*/ - -extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p); - -/* - ExecuteInitialProcedures - executes the initial procedures installed by - InstallInitialProcedure. -*/ - -extern "C" void M2RTS_ExecuteInitialProcedures (void); - -/* - InstallInitialProcedure - installs a procedure to be executed just - before the BEGIN code section of the - main program module. -*/ - -extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p); - -/* - ExecuteTerminationProcedures - calls each installed termination procedure - in reverse order. -*/ - -extern "C" void M2RTS_ExecuteTerminationProcedures (void); - -/* - Terminate - provides compatibility for pim. It calls exit with - the exitcode provided in a prior call to ExitOnHalt - (or zero if ExitOnHalt was never called). It does - not call ExecuteTerminationProcedures. -*/ - -extern "C" void M2RTS_Terminate (void) __attribute__ ((noreturn)); - -/* - HALT - terminate the current program. The procedure - ExecuteTerminationProcedures - is called before the program is stopped. The parameter - exitcode is optional. If the parameter is not supplied - HALT will call libc 'abort', otherwise it will exit with - the code supplied. Supplying a parameter to HALT has the - same effect as calling ExitOnHalt with the same code and - then calling HALT with no parameter. -*/ - -extern "C" void M2RTS_HALT (int exitcode) __attribute__ ((noreturn)); - -/* - Halt - provides a more user friendly version of HALT, which takes - four parameters to aid debugging. It writes an error message - to stderr and calls exit (1). -*/ - -extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn)); - -/* - HaltC - provides a more user friendly version of HALT, which takes - four parameters to aid debugging. It writes an error message - to stderr and calls exit (1). -*/ - -extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn)); - -/* - ExitOnHalt - if HALT is executed then call exit with the exit code, e. -*/ - -extern "C" void M2RTS_ExitOnHalt (int e); - -/* - ErrorMessage - emits an error message to stderr and then calls exit (1). -*/ - -extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn)); - -/* - Length - returns the length of a string, a. This is called whenever - the user calls LENGTH and the parameter cannot be calculated - at compile time. -*/ - -extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high); -extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); - -/* - ExecuteReverse - execute the procedure associated with procptr - and then proceed to try and execute all previous - procedures in the chain. -*/ - -static void ExecuteReverse (M2RTS_ProcedureChain procptr); - -/* - AppendProc - append proc to the end of the procedure list - defined by proclist. -*/ - -static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc); - -/* - ErrorString - writes a string to stderr. -*/ - -static void ErrorString (const char *a_, unsigned int _a_high); - -/* - ErrorStringC - writes a string to stderr. -*/ - -static void ErrorStringC (void * str); - -/* - ErrorMessageC - emits an error message to stderr and then calls exit (1). -*/ - -static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function) __attribute__ ((noreturn)); - -/* - InitProcList - initialize the head and tail pointers to NIL. -*/ - -static void InitProcList (M2RTS_ProcedureList *p); - -/* - Init - initialize the initial, terminate procedure lists and booleans. -*/ - -static void Init (void); - -/* - CheckInitialized - checks to see if this module has been initialized - and if it has not it calls Init. We need this - approach as this module is called by module ctors - before we reach main. -*/ - -static void CheckInitialized (void); - - -/* - ExecuteReverse - execute the procedure associated with procptr - and then proceed to try and execute all previous - procedures in the chain. -*/ - -static void ExecuteReverse (M2RTS_ProcedureChain procptr) -{ - while (procptr != NULL) - { - (*procptr->p.proc) (); /* Invoke the procedure. */ - procptr = procptr->prev; /* Invoke the procedure. */ - } -} - - -/* - AppendProc - append proc to the end of the procedure list - defined by proclist. -*/ - -static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc) -{ - M2RTS_ProcedureChain pdes; - - Storage_ALLOCATE ((void **) &pdes, sizeof (M2RTS__T1)); - pdes->p = proc; - pdes->prev = (*proclist).tail; - pdes->next = NULL; - if ((*proclist).head == NULL) - { - (*proclist).head = pdes; - } - (*proclist).tail = pdes; - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ErrorString - writes a string to stderr. -*/ - -static void ErrorString (const char *a_, unsigned int _a_high) -{ - int n; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - n = static_cast (libc_write (stderrFd, &a, static_cast (StrLib_StrLen ((const char *) a, _a_high)))); -} - - -/* - ErrorStringC - writes a string to stderr. -*/ - -static void ErrorStringC (void * str) -{ - int len; - - len = static_cast (libc_write (stderrFd, str, libc_strlen (str))); -} - - -/* - ErrorMessageC - emits an error message to stderr and then calls exit (1). -*/ - -static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function) -{ - typedef struct ErrorMessageC__T2_a ErrorMessageC__T2; - - struct ErrorMessageC__T2_a { char array[10+1]; }; - ErrorMessageC__T2 buffer; - - ErrorStringC (filename); - ErrorString ((const char *) ":", 1); - NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10); - ErrorString ((const char *) &buffer.array[0], 10); - ErrorString ((const char *) ":", 1); - if ((libc_strlen (function)) > 0) - { - ErrorString ((const char *) "in ", 3); - ErrorStringC (function); - ErrorString ((const char *) " has caused ", 12); - } - ErrorStringC (message); - buffer.array[0] = ASCII_nl; - buffer.array[1] = ASCII_nul; - ErrorString ((const char *) &buffer.array[0], 10); - libc_exit (1); -} - - -/* - InitProcList - initialize the head and tail pointers to NIL. -*/ - -static void InitProcList (M2RTS_ProcedureList *p) -{ - (*p).head = NULL; - (*p).tail = NULL; -} - - -/* - Init - initialize the initial, terminate procedure lists and booleans. -*/ - -static void Init (void) -{ - InitProcList (&InitialProc); - InitProcList (&TerminateProc); - ExitValue = 0; - isHalting = FALSE; - CallExit = FALSE; /* default by calling abort */ -} - - -/* - CheckInitialized - checks to see if this module has been initialized - and if it has not it calls Init. We need this - approach as this module is called by module ctors - before we reach main. -*/ - -static void CheckInitialized (void) -{ - if (! Initialized) - { - Initialized = TRUE; - Init (); - } -} - - -/* - ConstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp) -{ - M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp); -} - - -/* - DeconstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp) -{ - M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp); -} - - -/* - RegisterModule - adds module name to the list of outstanding - modules which need to have their dependencies - explored to determine initialization order. -*/ - -extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies) -{ - M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies); -} - - -/* - RequestDependant - used to specify that modulename is dependant upon - module dependantmodule. -*/ - -extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname) -{ - M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname); -} - - -/* - InstallTerminationProcedure - installs a procedure, p, which will - be called when the procedure - ExecuteTerminationProcedures - is invoked. It returns TRUE if the - procedure is installed. -*/ - -extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p) -{ - return AppendProc (&TerminateProc, p); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ExecuteInitialProcedures - executes the initial procedures installed by - InstallInitialProcedure. -*/ - -extern "C" void M2RTS_ExecuteInitialProcedures (void) -{ - ExecuteReverse (InitialProc.tail); -} - - -/* - InstallInitialProcedure - installs a procedure to be executed just - before the BEGIN code section of the - main program module. -*/ - -extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p) -{ - return AppendProc (&InitialProc, p); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ExecuteTerminationProcedures - calls each installed termination procedure - in reverse order. -*/ - -extern "C" void M2RTS_ExecuteTerminationProcedures (void) -{ - ExecuteReverse (TerminateProc.tail); -} - - -/* - Terminate - provides compatibility for pim. It calls exit with - the exitcode provided in a prior call to ExitOnHalt - (or zero if ExitOnHalt was never called). It does - not call ExecuteTerminationProcedures. -*/ - -extern "C" void M2RTS_Terminate (void) -{ - libc_exit (ExitValue); -} - - -/* - HALT - terminate the current program. The procedure - ExecuteTerminationProcedures - is called before the program is stopped. The parameter - exitcode is optional. If the parameter is not supplied - HALT will call libc 'abort', otherwise it will exit with - the code supplied. Supplying a parameter to HALT has the - same effect as calling ExitOnHalt with the same code and - then calling HALT with no parameter. -*/ - -extern "C" void M2RTS_HALT (int exitcode) -{ - if (exitcode != -1) - { - CallExit = TRUE; - ExitValue = exitcode; - } - if (isHalting) - { - /* double HALT found */ - libc_exit (-1); - } - else - { - isHalting = TRUE; - M2RTS_ExecuteTerminationProcedures (); - } - if (CallExit) - { - libc_exit (ExitValue); - } - else - { - libc_abort (); - } -} - - -/* - Halt - provides a more user friendly version of HALT, which takes - four parameters to aid debugging. It writes an error message - to stderr and calls exit (1). -*/ - -extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) -{ - char filename[_filename_high+1]; - char function[_function_high+1]; - char description[_description_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (filename, filename_, _filename_high+1); - memcpy (function, function_, _function_high+1); - memcpy (description, description_, _description_high+1); - - M2RTS_ErrorMessage ((const char *) description, _description_high, (const char *) filename, _filename_high, line, (const char *) function, _function_high); -} - - -/* - HaltC - provides a more user friendly version of HALT, which takes - four parameters to aid debugging. It writes an error message - to stderr and calls exit (1). -*/ - -extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) -{ - ErrorMessageC (description, filename, line, function); -} - - -/* - ExitOnHalt - if HALT is executed then call exit with the exit code, e. -*/ - -extern "C" void M2RTS_ExitOnHalt (int e) -{ - ExitValue = e; - CallExit = TRUE; -} - - -/* - ErrorMessage - emits an error message to stderr and then calls exit (1). -*/ - -extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) -{ - typedef struct ErrorMessage__T3_a ErrorMessage__T3; - - struct ErrorMessage__T3_a { char array[10+1]; }; - ErrorMessage__T3 buffer; - char message[_message_high+1]; - char filename[_filename_high+1]; - char function[_function_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (message, message_, _message_high+1); - memcpy (filename, filename_, _filename_high+1); - memcpy (function, function_, _function_high+1); - - ErrorString ((const char *) filename, _filename_high); - ErrorString ((const char *) ":", 1); - NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10); - ErrorString ((const char *) &buffer.array[0], 10); - ErrorString ((const char *) ":", 1); - if (! (StrLib_StrEqual ((const char *) function, _function_high, (const char *) "", 0))) - { - ErrorString ((const char *) "in ", 3); - ErrorString ((const char *) function, _function_high); - ErrorString ((const char *) " has caused ", 12); - } - ErrorString ((const char *) message, _message_high); - buffer.array[0] = ASCII_nl; - buffer.array[1] = ASCII_nul; - ErrorString ((const char *) &buffer.array[0], 10); - libc_exit (1); -} - - -/* - Length - returns the length of a string, a. This is called whenever - the user calls LENGTH and the parameter cannot be calculated - at compile time. -*/ - -extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high) -{ - unsigned int l; - unsigned int h; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - l = 0; - h = _a_high; - while ((l <= h) && (a[l] != ASCII_nul)) - { - l += 1; - } - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - /* - The following are the runtime exception handler routines. - */ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), filename, line, column, scope, message); -} - -extern "C" void _M2_M2RTS_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - CheckInitialized (); -} - -extern "C" void _M2_M2RTS_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GMemUtils.c b/gcc/m2/mc-boot/GMemUtils.c deleted file mode 100644 index a80e00ecec85..000000000000 --- a/gcc/m2/mc-boot/GMemUtils.c +++ /dev/null @@ -1,126 +0,0 @@ -/* do not edit automatically generated by mc from MemUtils. */ -/* MemUtils.mod provides some basic memory utilities. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _MemUtils_H -#define _MemUtils_C - -# include "GSYSTEM.h" - - -/* - MemCopy - copys a region of memory to the required destination. -*/ - -extern "C" void MemUtils_MemCopy (void * from, unsigned int length, void * to); - -/* - MemZero - sets a region of memory: a..a+length to zero. -*/ - -extern "C" void MemUtils_MemZero (void * a, unsigned int length); - - -/* - MemCopy - copys a region of memory to the required destination. -*/ - -extern "C" void MemUtils_MemCopy (void * from, unsigned int length, void * to) -{ - typedef unsigned int *MemCopy__T1; - - typedef unsigned char *MemCopy__T2; - - MemCopy__T1 pwb; - MemCopy__T1 pwa; - MemCopy__T2 pbb; - MemCopy__T2 pba; - - while (length >= sizeof (unsigned int )) - { - pwa = static_cast (from); - pwb = static_cast (to); - (*pwb) = (*pwa); - from = reinterpret_cast (reinterpret_cast (from)+sizeof (unsigned int )); - to = reinterpret_cast (reinterpret_cast (to)+sizeof (unsigned int )); - length -= sizeof (unsigned int ); - } - while (length > 0) - { - pba = static_cast (from); - pbb = static_cast (to); - (*pbb) = (*pba); - from = reinterpret_cast (reinterpret_cast (from)+sizeof (unsigned char )); - to = reinterpret_cast (reinterpret_cast (to)+sizeof (unsigned char )); - length -= sizeof (unsigned char ); - } -} - - -/* - MemZero - sets a region of memory: a..a+length to zero. -*/ - -extern "C" void MemUtils_MemZero (void * a, unsigned int length) -{ - typedef unsigned int *MemZero__T3; - - typedef unsigned char *MemZero__T4; - - MemZero__T3 pwa; - MemZero__T4 pba; - - pwa = static_cast (a); - while (length >= sizeof (unsigned int )) - { - (*pwa) = (unsigned int ) (0); - pwa += sizeof (unsigned int ); - length -= sizeof (unsigned int ); - } - pba = static_cast ((void *) (pwa)); - while (length >= sizeof (unsigned char )) - { - (*pba) = (unsigned char ) (0); - pba += sizeof (unsigned char ); - length -= sizeof (unsigned char ); - } -} - -extern "C" void _M2_MemUtils_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_MemUtils_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GNumberIO.c b/gcc/m2/mc-boot/GNumberIO.c deleted file mode 100644 index 53bac45552c0..000000000000 --- a/gcc/m2/mc-boot/GNumberIO.c +++ /dev/null @@ -1,776 +0,0 @@ -/* do not edit automatically generated by mc from NumberIO. */ -/* NumberIO.mod provides conversion of ordinal numbers. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#define _NumberIO_H -#define _NumberIO_C - -# include "GASCII.h" -# include "GStrIO.h" -# include "GStrLib.h" -# include "GM2RTS.h" - -# define MaxLineLength 79 -# define MaxDigits 20 -# define MaxHexDigits 20 -# define MaxOctDigits 40 -# define MaxBits 64 -extern "C" void NumberIO_ReadCard (unsigned int *x); -extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n); -extern "C" void NumberIO_ReadHex (unsigned int *x); -extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n); -extern "C" void NumberIO_ReadInt (int *x); -extern "C" void NumberIO_WriteInt (int x, unsigned int n); -extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_ReadOct (unsigned int *x); -extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n); -extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_ReadBin (unsigned int *x); -extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n); -extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x); - -extern "C" void NumberIO_ReadCard (unsigned int *x) -{ - typedef struct ReadCard__T1_a ReadCard__T1; - - struct ReadCard__T1_a { char array[MaxLineLength+1]; }; - ReadCard__T1 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToCard ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n) -{ - typedef struct WriteCard__T2_a WriteCard__T2; - - struct WriteCard__T2_a { char array[MaxLineLength+1]; }; - WriteCard__T2 a; - - NumberIO_CardToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_ReadHex (unsigned int *x) -{ - typedef struct ReadHex__T3_a ReadHex__T3; - - struct ReadHex__T3_a { char array[MaxLineLength+1]; }; - ReadHex__T3 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToHex ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n) -{ - typedef struct WriteHex__T4_a WriteHex__T4; - - struct WriteHex__T4_a { char array[MaxLineLength+1]; }; - WriteHex__T4 a; - - NumberIO_HexToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_ReadInt (int *x) -{ - typedef struct ReadInt__T5_a ReadInt__T5; - - struct ReadInt__T5_a { char array[MaxLineLength+1]; }; - ReadInt__T5 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToInt ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteInt (int x, unsigned int n) -{ - typedef struct WriteInt__T6_a WriteInt__T6; - - struct WriteInt__T6_a { char array[MaxLineLength+1]; }; - WriteInt__T6 a; - - NumberIO_IntToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct CardToStr__T7_a CardToStr__T7; - - struct CardToStr__T7_a { unsigned int array[MaxDigits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int Higha; - CardToStr__T7 buf; - - i = 0; - do { - i += 1; - if (i > MaxDigits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = x % 10; - x = x / 10; - } while (! (x == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = ' '; - j += 1; - n -= 1; - } - while ((i > 0) && (j <= Higha)) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if ((a[i] < '0') || (a[i] > '9')) - { - i += 1; - } - else - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - (*x) = (10*(*x))+( ((unsigned int) (a[i]))- ((unsigned int) ('0'))); - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if ((a[i] < '0') || (a[i] > '9')) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct HexToStr__T8_a HexToStr__T8; - - struct HexToStr__T8_a { unsigned int array[MaxHexDigits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int Higha; - HexToStr__T8 buf; - - i = 0; - do { - i += 1; - if (i > MaxHexDigits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = x % 0x010; - x = x / 0x010; - } while (! (x == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = '0'; - j += 1; - n -= 1; - } - while ((i != 0) && (j <= Higha)) - { - if (buf.array[i-1] < 10) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - } - else - { - a[j] = ((char) ((buf.array[i-1]+ ((unsigned int) ('A')))-10)); - } - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - NumberIO_StrToHexInt ((const char *) a, _a_high, &i); - (*x) = (unsigned int ) (i); -} - -extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct IntToStr__T9_a IntToStr__T9; - - struct IntToStr__T9_a { unsigned int array[MaxDigits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int c; - unsigned int Higha; - IntToStr__T9 buf; - unsigned int Negative; - - if (x < 0) - { - /* avoid dangling else. */ - Negative = TRUE; - c = ((unsigned int ) (abs (x+1)))+1; - if (n > 0) - { - n -= 1; - } - } - else - { - c = x; - Negative = FALSE; - } - i = 0; - do { - i += 1; - if (i > MaxDigits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = c % 10; - c = c / 10; - } while (! (c == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = ' '; - j += 1; - n -= 1; - } - if (Negative) - { - a[j] = '-'; - j += 1; - } - while ((i != 0) && (j <= Higha)) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int Negative; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - Negative = FALSE; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if (a[i] == '-') - { - i += 1; - Negative = ! Negative; - } - else if ((a[i] < '0') || (a[i] > '9')) - { - /* avoid dangling else. */ - i += 1; - } - else - { - /* avoid dangling else. */ - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - if (Negative) - { - (*x) = (10*(*x))-((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - } - else - { - (*x) = (10*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - } - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if ((a[i] < '0') || (a[i] > '9')) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void NumberIO_ReadOct (unsigned int *x) -{ - typedef struct ReadOct__T10_a ReadOct__T10; - - struct ReadOct__T10_a { char array[MaxLineLength+1]; }; - ReadOct__T10 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToOct ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n) -{ - typedef struct WriteOct__T11_a WriteOct__T11; - - struct WriteOct__T11_a { char array[MaxLineLength+1]; }; - WriteOct__T11 a; - - NumberIO_OctToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct OctToStr__T12_a OctToStr__T12; - - struct OctToStr__T12_a { unsigned int array[MaxOctDigits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int Higha; - OctToStr__T12 buf; - - i = 0; - do { - i += 1; - if (i > MaxOctDigits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = x % 8; - x = x / 8; - } while (! (x == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = ' '; - j += 1; - n -= 1; - } - while ((i > 0) && (j <= Higha)) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - NumberIO_StrToOctInt ((const char *) a, _a_high, &i); - (*x) = (unsigned int ) (i); -} - -extern "C" void NumberIO_ReadBin (unsigned int *x) -{ - typedef struct ReadBin__T13_a ReadBin__T13; - - struct ReadBin__T13_a { char array[MaxLineLength+1]; }; - ReadBin__T13 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToBin ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n) -{ - typedef struct WriteBin__T14_a WriteBin__T14; - - struct WriteBin__T14_a { char array[MaxLineLength+1]; }; - WriteBin__T14 a; - - NumberIO_BinToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct BinToStr__T15_a BinToStr__T15; - - struct BinToStr__T15_a { unsigned int array[MaxBits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int Higha; - BinToStr__T15 buf; - - i = 0; - do { - i += 1; - if (i > MaxBits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxBits", 27); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = x % 2; - x = x / 2; - } while (! (x == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = ' '; - j += 1; - n -= 1; - } - while ((i > 0) && (j <= Higha)) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - NumberIO_StrToBinInt ((const char *) a, _a_high, &i); - (*x) = (unsigned int ) (i); -} - -extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if ((a[i] < '0') || (a[i] > '1')) - { - i += 1; - } - else - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - (*x) = (2*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if ((a[i] < '0') || (a[i] > '1')) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if (((a[i] >= '0') && (a[i] <= '9')) || ((a[i] >= 'A') && (a[i] <= 'F'))) - { - ok = FALSE; - } - else - { - i += 1; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - if ((a[i] >= '0') && (a[i] <= '9')) - { - (*x) = (0x010*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - } - else if ((a[i] >= 'A') && (a[i] <= 'F')) - { - /* avoid dangling else. */ - (*x) = (0x010*(*x))+((int ) (( ((unsigned int) (a[i]))- ((unsigned int) ('A')))+10)); - } - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if (((a[i] < '0') || (a[i] > '9')) && ((a[i] < 'A') || (a[i] > 'F'))) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if ((a[i] < '0') || (a[i] > '7')) - { - i += 1; - } - else - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - (*x) = (8*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if ((a[i] < '0') || (a[i] > '7')) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void _M2_NumberIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_NumberIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GPushBackInput.c b/gcc/m2/mc-boot/GPushBackInput.c deleted file mode 100644 index e15b3eb90079..000000000000 --- a/gcc/m2/mc-boot/GPushBackInput.c +++ /dev/null @@ -1,488 +0,0 @@ -/* do not edit automatically generated by mc from PushBackInput. */ -/* PushBackInput.mod provides a method for pushing back and consuming input. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _PushBackInput_H -#define _PushBackInput_C - -# include "GFIO.h" -# include "GDynamicStrings.h" -# include "GASCII.h" -# include "GDebug.h" -# include "GStrLib.h" -# include "GNumberIO.h" -# include "GStrIO.h" -# include "GStdIO.h" -# include "Glibc.h" - -# define MaxPushBackStack 8192 -# define MaxFileName 4096 -typedef struct PushBackInput__T2_a PushBackInput__T2; - -typedef struct PushBackInput__T3_a PushBackInput__T3; - -struct PushBackInput__T2_a { char array[MaxFileName+1]; }; -struct PushBackInput__T3_a { char array[MaxPushBackStack+1]; }; -static PushBackInput__T2 FileName; -static PushBackInput__T3 CharStack; -static unsigned int ExitStatus; -static unsigned int Column; -static unsigned int StackPtr; -static unsigned int LineNo; -static unsigned int Debugging; - -/* - Open - opens a file for reading. -*/ - -extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high); - -/* - GetCh - gets a character from either the push back stack or - from file, f. -*/ - -extern "C" char PushBackInput_GetCh (FIO_File f); - -/* - PutCh - pushes a character onto the push back stack, it also - returns the character which has been pushed. -*/ - -extern "C" char PushBackInput_PutCh (char ch); - -/* - PutString - pushes a string onto the push back stack. -*/ - -extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high); - -/* - PutStr - pushes a dynamic string onto the push back stack. - The string, s, is not deallocated. -*/ - -extern "C" void PushBackInput_PutStr (DynamicStrings_String s); - -/* - Error - emits an error message with the appropriate file, line combination. -*/ - -extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high); - -/* - WarnError - emits an error message with the appropriate file, line combination. - It does not terminate but when the program finishes an exit status of - 1 will be issued. -*/ - -extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high); - -/* - WarnString - emits an error message with the appropriate file, line combination. - It does not terminate but when the program finishes an exit status of - 1 will be issued. -*/ - -extern "C" void PushBackInput_WarnString (DynamicStrings_String s); - -/* - Close - closes the opened file. -*/ - -extern "C" void PushBackInput_Close (FIO_File f); - -/* - GetExitStatus - returns the exit status which will be 1 if any warnings were issued. -*/ - -extern "C" unsigned int PushBackInput_GetExitStatus (void); - -/* - SetDebug - sets the debug flag on or off. -*/ - -extern "C" void PushBackInput_SetDebug (unsigned int d); - -/* - GetColumnPosition - returns the column position of the current character. -*/ - -extern "C" unsigned int PushBackInput_GetColumnPosition (void); - -/* - GetCurrentLine - returns the current line number. -*/ - -extern "C" unsigned int PushBackInput_GetCurrentLine (void); - -/* - ErrChar - writes a char, ch, to stderr. -*/ - -static void ErrChar (char ch); - -/* - Init - initialize global variables. -*/ - -static void Init (void); - - -/* - ErrChar - writes a char, ch, to stderr. -*/ - -static void ErrChar (char ch) -{ - FIO_WriteChar (FIO_StdErr, ch); -} - - -/* - Init - initialize global variables. -*/ - -static void Init (void) -{ - ExitStatus = 0; - StackPtr = 0; - LineNo = 1; - Column = 0; -} - - -/* - Open - opens a file for reading. -*/ - -extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - Init (); - StrLib_StrCopy ((const char *) a, _a_high, (char *) &FileName.array[0], MaxFileName); - return FIO_OpenToRead ((const char *) a, _a_high); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetCh - gets a character from either the push back stack or - from file, f. -*/ - -extern "C" char PushBackInput_GetCh (FIO_File f) -{ - char ch; - - if (StackPtr > 0) - { - StackPtr -= 1; - if (Debugging) - { - StdIO_Write (CharStack.array[StackPtr]); - } - return CharStack.array[StackPtr]; - } - else - { - if ((FIO_EOF (f)) || (! (FIO_IsNoError (f)))) - { - ch = ASCII_nul; - } - else - { - do { - ch = FIO_ReadChar (f); - } while (! (((ch != ASCII_cr) || (FIO_EOF (f))) || (! (FIO_IsNoError (f))))); - if (ch == ASCII_lf) - { - Column = 0; - LineNo += 1; - } - else - { - Column += 1; - } - } - if (Debugging) - { - StdIO_Write (ch); - } - return ch; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PutCh - pushes a character onto the push back stack, it also - returns the character which has been pushed. -*/ - -extern "C" char PushBackInput_PutCh (char ch) -{ - if (StackPtr < MaxPushBackStack) - { - CharStack.array[StackPtr] = ch; - StackPtr += 1; - } - else - { - Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54); - } - return ch; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PutString - pushes a string onto the push back stack. -*/ - -extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high) -{ - unsigned int l; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - l = StrLib_StrLen ((const char *) a, _a_high); - while (l > 0) - { - l -= 1; - if ((PushBackInput_PutCh (a[l])) != a[l]) - { - Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54); - } - } -} - - -/* - PutStr - pushes a dynamic string onto the push back stack. - The string, s, is not deallocated. -*/ - -extern "C" void PushBackInput_PutStr (DynamicStrings_String s) -{ - unsigned int i; - - i = DynamicStrings_Length (s); - while (i > 0) - { - i -= 1; - if ((PushBackInput_PutCh (DynamicStrings_char (s, static_cast (i)))) != (DynamicStrings_char (s, static_cast (i)))) - { - Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54); - } - } -} - - -/* - Error - emits an error message with the appropriate file, line combination. -*/ - -extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar}); - StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName); - StdIO_Write (':'); - NumberIO_WriteCard (LineNo, 0); - StdIO_Write (':'); - StrIO_WriteString ((const char *) a, _a_high); - StrIO_WriteLn (); - StdIO_PopOutput (); - FIO_Close (FIO_StdErr); - libc_exit (1); -} - - -/* - WarnError - emits an error message with the appropriate file, line combination. - It does not terminate but when the program finishes an exit status of - 1 will be issued. -*/ - -extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar}); - StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName); - StdIO_Write (':'); - NumberIO_WriteCard (LineNo, 0); - StdIO_Write (':'); - StrIO_WriteString ((const char *) a, _a_high); - StrIO_WriteLn (); - StdIO_PopOutput (); - ExitStatus = 1; -} - - -/* - WarnString - emits an error message with the appropriate file, line combination. - It does not terminate but when the program finishes an exit status of - 1 will be issued. -*/ - -extern "C" void PushBackInput_WarnString (DynamicStrings_String s) -{ - typedef char *WarnString__T1; - - WarnString__T1 p; - - p = static_cast (DynamicStrings_string (s)); - StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName); - StdIO_Write (':'); - NumberIO_WriteCard (LineNo, 0); - StdIO_Write (':'); - do { - if (p != NULL) - { - if ((*p) == ASCII_lf) - { - StrIO_WriteLn (); - StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName); - StdIO_Write (':'); - NumberIO_WriteCard (LineNo, 0); - StdIO_Write (':'); - } - else - { - StdIO_Write ((*p)); - } - p += 1; - } - } while (! ((p == NULL) || ((*p) == ASCII_nul))); - ExitStatus = 1; -} - - -/* - Close - closes the opened file. -*/ - -extern "C" void PushBackInput_Close (FIO_File f) -{ - FIO_Close (f); -} - - -/* - GetExitStatus - returns the exit status which will be 1 if any warnings were issued. -*/ - -extern "C" unsigned int PushBackInput_GetExitStatus (void) -{ - return ExitStatus; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SetDebug - sets the debug flag on or off. -*/ - -extern "C" void PushBackInput_SetDebug (unsigned int d) -{ - Debugging = d; -} - - -/* - GetColumnPosition - returns the column position of the current character. -*/ - -extern "C" unsigned int PushBackInput_GetColumnPosition (void) -{ - if (StackPtr > Column) - { - return 0; - } - else - { - return Column-StackPtr; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetCurrentLine - returns the current line number. -*/ - -extern "C" unsigned int PushBackInput_GetCurrentLine (void) -{ - return LineNo; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_PushBackInput_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - PushBackInput_SetDebug (FALSE); - Init (); -} - -extern "C" void _M2_PushBackInput_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GRTExceptions.c b/gcc/m2/mc-boot/GRTExceptions.c deleted file mode 100644 index 23f8fede117b..000000000000 --- a/gcc/m2/mc-boot/GRTExceptions.c +++ /dev/null @@ -1,1223 +0,0 @@ -/* do not edit automatically generated by mc from RTExceptions. */ -/* RTExceptions.mod runtime exception handler routines. - -Copyright (C) 2008-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#ifndef __cplusplus -extern void throw (unsigned int); -#endif -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _RTExceptions_H -#define _RTExceptions_C - -# include "GASCII.h" -# include "GStrLib.h" -# include "GStorage.h" -# include "GSYSTEM.h" -# include "Glibc.h" -# include "GM2RTS.h" -# include "GSysExceptions.h" -# include "GM2EXCEPTION.h" - -typedef struct RTExceptions_ProcedureHandler_p RTExceptions_ProcedureHandler; - -# define MaxBuffer 4096 -typedef struct RTExceptions__T1_r RTExceptions__T1; - -typedef char *RTExceptions_PtrToChar; - -typedef struct RTExceptions__T2_a RTExceptions__T2; - -typedef struct RTExceptions__T3_r RTExceptions__T3; - -typedef RTExceptions__T3 *RTExceptions_Handler; - -typedef RTExceptions__T1 *RTExceptions_EHBlock; - -typedef void (*RTExceptions_ProcedureHandler_t) (void); -struct RTExceptions_ProcedureHandler_p { RTExceptions_ProcedureHandler_t proc; }; - -struct RTExceptions__T2_a { char array[MaxBuffer+1]; }; -struct RTExceptions__T1_r { - RTExceptions__T2 buffer; - unsigned int number; - RTExceptions_Handler handlers; - RTExceptions_EHBlock right; - }; - -struct RTExceptions__T3_r { - RTExceptions_ProcedureHandler p; - unsigned int n; - RTExceptions_Handler right; - RTExceptions_Handler left; - RTExceptions_Handler stack; - }; - -static unsigned int inException; -static RTExceptions_Handler freeHandler; -static RTExceptions_EHBlock freeEHB; -static RTExceptions_EHBlock currentEHB; -static void * currentSource; - -/* - Raise - invoke the exception handler associated with, number, - in the active EHBlock. It keeps a record of the number - and message in the EHBlock for later use. -*/ - -extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) __attribute__ ((noreturn)); - -/* - SetExceptionBlock - sets, source, as the active EHB. -*/ - -extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source); - -/* - GetExceptionBlock - returns the active EHB. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void); - -/* - GetTextBuffer - returns the address of the EHB buffer. -*/ - -extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e); - -/* - GetTextBufferSize - return the size of the EHB text buffer. -*/ - -extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e); - -/* - GetNumber - return the exception number associated with, - source. -*/ - -extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source); - -/* - InitExceptionBlock - creates and returns a new exception block. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void); - -/* - KillExceptionBlock - destroys the EHB, e, and all its handlers. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e); - -/* - PushHandler - install a handler in EHB, e. -*/ - -extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p); - -/* - PopHandler - removes the handler associated with, number, from - EHB, e. -*/ - -extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number); - -/* - DefaultErrorCatch - displays the current error message in - the current exception block and then - calls HALT. -*/ - -extern "C" void RTExceptions_DefaultErrorCatch (void); - -/* - BaseExceptionsThrow - configures the Modula-2 exceptions to call - THROW which in turn can be caught by an - exception block. If this is not called then - a Modula-2 exception will simply call an - error message routine and then HALT. -*/ - -extern "C" void RTExceptions_BaseExceptionsThrow (void); - -/* - IsInExceptionState - returns TRUE if the program is currently - in the exception state. -*/ - -extern "C" unsigned int RTExceptions_IsInExceptionState (void); - -/* - SetExceptionState - returns the current exception state and - then sets the current exception state to, - to. -*/ - -extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to); - -/* - SwitchExceptionState - assigns, from, with the current exception - state and then assigns the current exception - to, to. -*/ - -extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to); - -/* - GetBaseExceptionBlock - returns the initial language exception block - created. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void); - -/* - SetExceptionSource - sets the current exception source to, source. -*/ - -extern "C" void RTExceptions_SetExceptionSource (void * source); - -/* - GetExceptionSource - returns the current exception source. -*/ - -extern "C" void * RTExceptions_GetExceptionSource (void); - -/* - ErrorString - writes a string to stderr. -*/ - -static void ErrorString (const char *a_, unsigned int _a_high); - -/* - findHandler - -*/ - -static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number); - -/* - InvokeHandler - invokes the associated handler for the current - exception in the active EHB. -*/ - -static void InvokeHandler (void) __attribute__ ((noreturn)); - -/* - DoThrow - throw the exception number in the exception block. -*/ - -static void DoThrow (void); - -/* - addChar - adds, ch, to the current exception handler text buffer - at index, i. The index in then incremented. -*/ - -static void addChar (char ch, unsigned int *i); - -/* - stripPath - returns the filename from the path. -*/ - -static void * stripPath (void * s); - -/* - addFile - adds the filename determined by, s, however it strips - any preceeding path. -*/ - -static void addFile (void * s, unsigned int *i); - -/* - addStr - adds a C string from address, s, into the current - handler text buffer. -*/ - -static void addStr (void * s, unsigned int *i); - -/* - addNum - adds a number, n, to the current handler - text buffer. -*/ - -static void addNum (unsigned int n, unsigned int *i); - -/* - New - returns a new EHBlock. -*/ - -static RTExceptions_EHBlock New (void); - -/* - NewHandler - returns a new handler. -*/ - -static RTExceptions_Handler NewHandler (void); - -/* - KillHandler - returns, NIL, and places, h, onto the free list. -*/ - -static RTExceptions_Handler KillHandler (RTExceptions_Handler h); - -/* - KillHandlers - kills all handlers in the list. -*/ - -static RTExceptions_Handler KillHandlers (RTExceptions_Handler h); - -/* - InitHandler - -*/ - -static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc); - -/* - SubHandler - -*/ - -static void SubHandler (RTExceptions_Handler h); - -/* - AddHandler - add, e, to the end of the list of handlers. -*/ - -static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h); - -/* - indexf - raise an index out of bounds exception. -*/ - -static void indexf (void * a); - -/* - range - raise an assignment out of range exception. -*/ - -static void range (void * a); - -/* - casef - raise a case selector out of range exception. -*/ - -static void casef (void * a); - -/* - invalidloc - raise an invalid location exception. -*/ - -static void invalidloc (void * a); - -/* - function - raise a ... function ... exception. --fixme-- what does this exception catch? -*/ - -static void function (void * a); - -/* - wholevalue - raise an illegal whole value exception. -*/ - -static void wholevalue (void * a); - -/* - wholediv - raise a division by zero exception. -*/ - -static void wholediv (void * a); - -/* - realvalue - raise an illegal real value exception. -*/ - -static void realvalue (void * a); - -/* - realdiv - raise a division by zero in a real number exception. -*/ - -static void realdiv (void * a); - -/* - complexvalue - raise an illegal complex value exception. -*/ - -static void complexvalue (void * a); - -/* - complexdiv - raise a division by zero in a complex number exception. -*/ - -static void complexdiv (void * a); - -/* - protection - raise a protection exception. -*/ - -static void protection (void * a); - -/* - systemf - raise a system exception. -*/ - -static void systemf (void * a); - -/* - coroutine - raise a coroutine exception. -*/ - -static void coroutine (void * a); - -/* - exception - raise a exception exception. -*/ - -static void exception (void * a); - -/* - Init - initialises this module. -*/ - -static void Init (void); - -/* - TidyUp - deallocate memory used by this module. -*/ - -static void TidyUp (void); - - -/* - ErrorString - writes a string to stderr. -*/ - -static void ErrorString (const char *a_, unsigned int _a_high) -{ - int n; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - n = static_cast (libc_write (2, &a, static_cast (StrLib_StrLen ((const char *) a, _a_high)))); -} - - -/* - findHandler - -*/ - -static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number) -{ - RTExceptions_Handler h; - - h = e->handlers->right; - while ((h != e->handlers) && (number != h->n)) - { - h = h->right; - } - if (h == e->handlers) - { - return NULL; - } - else - { - return h; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InvokeHandler - invokes the associated handler for the current - exception in the active EHB. -*/ - -static void InvokeHandler (void) -{ - RTExceptions_Handler h; - - h = findHandler (currentEHB, currentEHB->number); - if (h == NULL) - { - throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ())); - } - else - { - (*h->p.proc) (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - DoThrow - throw the exception number in the exception block. -*/ - -static void DoThrow (void) -{ - throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ())); -} - - -/* - addChar - adds, ch, to the current exception handler text buffer - at index, i. The index in then incremented. -*/ - -static void addChar (char ch, unsigned int *i) -{ - if (((*i) <= MaxBuffer) && (currentEHB != NULL)) - { - currentEHB->buffer.array[(*i)] = ch; - (*i) += 1; - } -} - - -/* - stripPath - returns the filename from the path. -*/ - -static void * stripPath (void * s) -{ - RTExceptions_PtrToChar f; - RTExceptions_PtrToChar p; - - p = static_cast (s); - f = static_cast (s); - while ((*p) != ASCII_nul) - { - if ((*p) == '/') - { - p += 1; - f = p; - } - else - { - p += 1; - } - } - return reinterpret_cast (f); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addFile - adds the filename determined by, s, however it strips - any preceeding path. -*/ - -static void addFile (void * s, unsigned int *i) -{ - RTExceptions_PtrToChar p; - - p = static_cast (stripPath (s)); - while ((p != NULL) && ((*p) != ASCII_nul)) - { - addChar ((*p), i); - p += 1; - } -} - - -/* - addStr - adds a C string from address, s, into the current - handler text buffer. -*/ - -static void addStr (void * s, unsigned int *i) -{ - RTExceptions_PtrToChar p; - - p = static_cast (s); - while ((p != NULL) && ((*p) != ASCII_nul)) - { - addChar ((*p), i); - p += 1; - } -} - - -/* - addNum - adds a number, n, to the current handler - text buffer. -*/ - -static void addNum (unsigned int n, unsigned int *i) -{ - if (n < 10) - { - addChar ( ((char) ((n % 10)+ ((unsigned int) ('0')))), i); - } - else - { - addNum (n / 10, i); - addNum (n % 10, i); - } -} - - -/* - New - returns a new EHBlock. -*/ - -static RTExceptions_EHBlock New (void) -{ - RTExceptions_EHBlock e; - - if (freeEHB == NULL) - { - Storage_ALLOCATE ((void **) &e, sizeof (RTExceptions__T1)); - } - else - { - e = freeEHB; - freeEHB = freeEHB->right; - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NewHandler - returns a new handler. -*/ - -static RTExceptions_Handler NewHandler (void) -{ - RTExceptions_Handler h; - - if (freeHandler == NULL) - { - Storage_ALLOCATE ((void **) &h, sizeof (RTExceptions__T3)); - } - else - { - h = freeHandler; - freeHandler = freeHandler->right; - } - return h; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillHandler - returns, NIL, and places, h, onto the free list. -*/ - -static RTExceptions_Handler KillHandler (RTExceptions_Handler h) -{ - h->right = freeHandler; - freeHandler = h; - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillHandlers - kills all handlers in the list. -*/ - -static RTExceptions_Handler KillHandlers (RTExceptions_Handler h) -{ - h->left->right = freeHandler; - freeHandler = h; - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitHandler - -*/ - -static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc) -{ - h->p = proc; - h->n = number; - h->right = r; - h->left = l; - h->stack = s; - return h; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SubHandler - -*/ - -static void SubHandler (RTExceptions_Handler h) -{ - h->right->left = h->left; - h->left->right = h->right; -} - - -/* - AddHandler - add, e, to the end of the list of handlers. -*/ - -static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h) -{ - h->right = e->handlers; - h->left = e->handlers->left; - e->handlers->left->right = h; - e->handlers->left = h; -} - - -/* - indexf - raise an index out of bounds exception. -*/ - -static void indexf (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast (reinterpret_cast("indexf")), const_cast (reinterpret_cast("array index out of bounds"))); -} - - -/* - range - raise an assignment out of range exception. -*/ - -static void range (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast (reinterpret_cast("range")), const_cast (reinterpret_cast("assignment out of range"))); -} - - -/* - casef - raise a case selector out of range exception. -*/ - -static void casef (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast (reinterpret_cast("casef")), const_cast (reinterpret_cast("case selector out of range"))); -} - - -/* - invalidloc - raise an invalid location exception. -*/ - -static void invalidloc (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast (reinterpret_cast("invalidloc")), const_cast (reinterpret_cast("invalid address referenced"))); -} - - -/* - function - raise a ... function ... exception. --fixme-- what does this exception catch? -*/ - -static void function (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast (reinterpret_cast("function")), const_cast (reinterpret_cast("... function ... "))); /* --fixme-- what has happened ? */ -} - - -/* - wholevalue - raise an illegal whole value exception. -*/ - -static void wholevalue (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast (reinterpret_cast("wholevalue")), const_cast (reinterpret_cast("illegal whole value exception"))); -} - - -/* - wholediv - raise a division by zero exception. -*/ - -static void wholediv (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast (reinterpret_cast("wholediv")), const_cast (reinterpret_cast("illegal whole value exception"))); -} - - -/* - realvalue - raise an illegal real value exception. -*/ - -static void realvalue (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast (reinterpret_cast("realvalue")), const_cast (reinterpret_cast("illegal real value exception"))); -} - - -/* - realdiv - raise a division by zero in a real number exception. -*/ - -static void realdiv (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast (reinterpret_cast("realdiv")), const_cast (reinterpret_cast("real number division by zero exception"))); -} - - -/* - complexvalue - raise an illegal complex value exception. -*/ - -static void complexvalue (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast (reinterpret_cast("complexvalue")), const_cast (reinterpret_cast("illegal complex value exception"))); -} - - -/* - complexdiv - raise a division by zero in a complex number exception. -*/ - -static void complexdiv (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast (reinterpret_cast("complexdiv")), const_cast (reinterpret_cast("complex number division by zero exception"))); -} - - -/* - protection - raise a protection exception. -*/ - -static void protection (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast (reinterpret_cast("protection")), const_cast (reinterpret_cast("protection exception"))); -} - - -/* - systemf - raise a system exception. -*/ - -static void systemf (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast (reinterpret_cast("systemf")), const_cast (reinterpret_cast("system exception"))); -} - - -/* - coroutine - raise a coroutine exception. -*/ - -static void coroutine (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast (reinterpret_cast("coroutine")), const_cast (reinterpret_cast("coroutine exception"))); -} - - -/* - exception - raise a exception exception. -*/ - -static void exception (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast (reinterpret_cast("exception")), const_cast (reinterpret_cast("exception exception"))); -} - - -/* - Init - initialises this module. -*/ - -static void Init (void) -{ - inException = FALSE; - freeHandler = NULL; - freeEHB = NULL; - currentEHB = RTExceptions_InitExceptionBlock (); - currentSource = NULL; - RTExceptions_BaseExceptionsThrow (); - SysExceptions_InitExceptionHandlers ((SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) indexf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) range}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) casef}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) invalidloc}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) function}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholevalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholediv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) protection}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) systemf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) coroutine}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) exception}); -} - - -/* - TidyUp - deallocate memory used by this module. -*/ - -static void TidyUp (void) -{ - RTExceptions_Handler f; - RTExceptions_EHBlock e; - - if (currentEHB != NULL) - { - currentEHB = RTExceptions_KillExceptionBlock (currentEHB); - } - while (freeHandler != NULL) - { - f = freeHandler; - freeHandler = freeHandler->right; - Storage_DEALLOCATE ((void **) &f, sizeof (RTExceptions__T3)); - } - while (freeEHB != NULL) - { - e = freeEHB; - freeEHB = freeEHB->right; - Storage_DEALLOCATE ((void **) &e, sizeof (RTExceptions__T1)); - } -} - - -/* - Raise - invoke the exception handler associated with, number, - in the active EHBlock. It keeps a record of the number - and message in the EHBlock for later use. -*/ - -extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) -{ - unsigned int i; - - currentEHB->number = number; - i = 0; - addFile (file, &i); - addChar (':', &i); - addNum (line, &i); - addChar (':', &i); - addNum (column, &i); - addChar (':', &i); - addChar (' ', &i); - addChar ('I', &i); - addChar ('n', &i); - addChar (' ', &i); - addStr (function, &i); - addChar (ASCII_nl, &i); - addFile (file, &i); - addChar (':', &i); - addNum (line, &i); - addChar (':', &i); - addNum (column, &i); - addChar (':', &i); - addStr (message, &i); - addChar (ASCII_nl, &i); - addChar (ASCII_nul, &i); - InvokeHandler (); -} - - -/* - SetExceptionBlock - sets, source, as the active EHB. -*/ - -extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source) -{ - currentEHB = source; -} - - -/* - GetExceptionBlock - returns the active EHB. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void) -{ - return currentEHB; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetTextBuffer - returns the address of the EHB buffer. -*/ - -extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e) -{ - return &e->buffer; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetTextBufferSize - return the size of the EHB text buffer. -*/ - -extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e) -{ - return sizeof (e->buffer); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetNumber - return the exception number associated with, - source. -*/ - -extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source) -{ - return source->number; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitExceptionBlock - creates and returns a new exception block. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void) -{ - RTExceptions_EHBlock e; - - e = New (); - e->number = UINT_MAX; - e->handlers = NewHandler (); /* add the dummy onto the head */ - e->handlers->right = e->handlers; /* add the dummy onto the head */ - e->handlers->left = e->handlers; - e->right = e; - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillExceptionBlock - destroys the EHB, e, and all its handlers. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e) -{ - e->handlers = KillHandlers (e->handlers); - e->right = freeEHB; - freeEHB = e; - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PushHandler - install a handler in EHB, e. -*/ - -extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p) -{ - RTExceptions_Handler h; - RTExceptions_Handler i; - - h = findHandler (e, number); - if (h == NULL) - { - i = InitHandler (NewHandler (), NULL, NULL, NULL, number, p); - } - else - { - /* remove, h, */ - SubHandler (h); - /* stack it onto a new handler */ - i = InitHandler (NewHandler (), NULL, NULL, h, number, p); - } - /* add new handler */ - AddHandler (e, i); -} - - -/* - PopHandler - removes the handler associated with, number, from - EHB, e. -*/ - -extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number) -{ - RTExceptions_Handler h; - RTExceptions_Handler i; - - h = findHandler (e, number); - if (h != NULL) - { - /* remove, h, */ - SubHandler (h); - if (h->stack != NULL) - { - AddHandler (e, h->stack); - } - h = KillHandler (h); - } -} - - -/* - DefaultErrorCatch - displays the current error message in - the current exception block and then - calls HALT. -*/ - -extern "C" void RTExceptions_DefaultErrorCatch (void) -{ - RTExceptions_EHBlock e; - int n; - - e = RTExceptions_GetExceptionBlock (); - n = static_cast (libc_write (2, RTExceptions_GetTextBuffer (e), libc_strlen (RTExceptions_GetTextBuffer (e)))); - M2RTS_HALT (-1); - __builtin_unreachable (); -} - - -/* - BaseExceptionsThrow - configures the Modula-2 exceptions to call - THROW which in turn can be caught by an - exception block. If this is not called then - a Modula-2 exception will simply call an - error message routine and then HALT. -*/ - -extern "C" void RTExceptions_BaseExceptionsThrow (void) -{ - M2EXCEPTION_M2Exceptions i; - - for (i=M2EXCEPTION_indexException; i<=M2EXCEPTION_exException; i= static_cast(static_cast(i+1))) - { - RTExceptions_PushHandler (RTExceptions_GetExceptionBlock (), (unsigned int ) (i), (RTExceptions_ProcedureHandler) {(RTExceptions_ProcedureHandler_t) DoThrow}); - } -} - - -/* - IsInExceptionState - returns TRUE if the program is currently - in the exception state. -*/ - -extern "C" unsigned int RTExceptions_IsInExceptionState (void) -{ - return inException; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SetExceptionState - returns the current exception state and - then sets the current exception state to, - to. -*/ - -extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to) -{ - unsigned int old; - - old = inException; - inException = to; - return old; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SwitchExceptionState - assigns, from, with the current exception - state and then assigns the current exception - to, to. -*/ - -extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to) -{ - (*from) = inException; - inException = to; -} - - -/* - GetBaseExceptionBlock - returns the initial language exception block - created. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void) -{ - if (currentEHB == NULL) - { - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39); - } - else - { - return currentEHB; - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1); - __builtin_unreachable (); -} - - -/* - SetExceptionSource - sets the current exception source to, source. -*/ - -extern "C" void RTExceptions_SetExceptionSource (void * source) -{ - currentSource = source; -} - - -/* - GetExceptionSource - returns the current exception source. -*/ - -extern "C" void * RTExceptions_GetExceptionSource (void) -{ - return currentSource; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_RTExceptions_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_RTExceptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - TidyUp (); -} diff --git a/gcc/m2/mc-boot/GRTint.c b/gcc/m2/mc-boot/GRTint.c deleted file mode 100644 index a3030f2d9a14..000000000000 --- a/gcc/m2/mc-boot/GRTint.c +++ /dev/null @@ -1,1106 +0,0 @@ -/* do not edit automatically generated by mc from RTint. */ -/* RTint.mod provides users of the COROUTINES library with the. - -Copyright (C) 2009-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _RTint_H -#define _RTint_C - -# include "GM2RTS.h" -# include "GStorage.h" -# include "GRTco.h" -# include "GCOROUTINES.h" -# include "Glibc.h" -# include "GAssertion.h" -# include "GSelective.h" - -typedef struct RTint_DispatchVector_p RTint_DispatchVector; - -# define Microseconds 1000000 -# define DebugTime 0 -# define Debugging FALSE -typedef struct RTint__T1_r RTint__T1; - -typedef RTint__T1 *RTint_Vector; - -typedef struct RTint__T2_a RTint__T2; - -typedef enum {RTint_input, RTint_output, RTint_time} RTint_VectorType; - -typedef void (*RTint_DispatchVector_t) (unsigned int, unsigned int, void *); -struct RTint_DispatchVector_p { RTint_DispatchVector_t proc; }; - -struct RTint__T1_r { - RTint_VectorType type; - unsigned int priority; - void *arg; - RTint_Vector pending; - RTint_Vector exists; - unsigned int no; - int File; - Selective_Timeval rel; - Selective_Timeval abs_; - unsigned int queued; - }; - -struct RTint__T2_a { RTint_Vector array[(7)-(COROUTINES_UnassignedPriority)+1]; }; -static unsigned int VecNo; -static RTint_Vector Exists; -static RTint__T2 Pending; -static int lock; -static unsigned int initialized; - -/* - InitInputVector - returns an interrupt vector which is associated - with the file descriptor, fd. -*/ - -extern "C" unsigned int RTint_InitInputVector (int fd, unsigned int pri); - -/* - InitOutputVector - returns an interrupt vector which is associated - with the file descriptor, fd. -*/ - -extern "C" unsigned int RTint_InitOutputVector (int fd, unsigned int pri); - -/* - InitTimeVector - returns an interrupt vector associated with - the relative time. -*/ - -extern "C" unsigned int RTint_InitTimeVector (unsigned int micro, unsigned int secs, unsigned int pri); - -/* - ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt - at the new relative time. -*/ - -extern "C" void RTint_ReArmTimeVector (unsigned int vec, unsigned int micro, unsigned int secs); - -/* - GetTimeVector - assigns, micro, and, secs, with the remaining - time before this interrupt will expire. - This value is only updated when a Listen - occurs. -*/ - -extern "C" void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsigned int *secs); - -/* - AttachVector - adds the pointer ptr to be associated with the interrupt - vector. It returns the previous value attached to this - vector. -*/ - -extern "C" void * RTint_AttachVector (unsigned int vec, void * ptr); - -/* - IncludeVector - includes, vec, into the dispatcher list of - possible interrupt causes. -*/ - -extern "C" void RTint_IncludeVector (unsigned int vec); - -/* - ExcludeVector - excludes, vec, from the dispatcher list of - possible interrupt causes. -*/ - -extern "C" void RTint_ExcludeVector (unsigned int vec); - -/* - Listen - will either block indefinitely (until an interrupt) - or alteratively will test to see whether any interrupts - are pending. - If a pending interrupt was found then, call, is called - and then this procedure returns. - It only listens for interrupts > pri. -*/ - -extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri); - -/* - Init - -*/ - -extern "C" void RTint_Init (void); - -/* - Max - returns the maximum: i or j. -*/ - -static int Max (int i, int j); -static int Min (int i, int j); - -/* - FindVector - searches the exists list for a vector of type - which is associated with file descriptor, fd. -*/ - -static RTint_Vector FindVector (int fd, RTint_VectorType type); - -/* - FindVectorNo - searches the Exists list for vector vec. -*/ - -static RTint_Vector FindVectorNo (unsigned int vec); - -/* - FindPendingVector - searches the pending list for vector, vec. -*/ - -static RTint_Vector FindPendingVector (unsigned int vec); - -/* - AddFd - adds the file descriptor fd to set updating max. -*/ - -static void AddFd (Selective_SetOfFd *set, int *max, int fd); - -/* - DumpPendingQueue - displays the pending queue. -*/ - -static void DumpPendingQueue (void); - -/* - AddTime - t1 := t1 + t2 -*/ - -static void AddTime (Selective_Timeval t1, Selective_Timeval t2); - -/* - IsGreaterEqual - returns TRUE if, a>=b -*/ - -static unsigned int IsGreaterEqual (Selective_Timeval a, Selective_Timeval b); - -/* - SubTime - assigns, s and m, to a - b. -*/ - -static void SubTime (unsigned int *s, unsigned int *m, Selective_Timeval a, Selective_Timeval b); - -/* - activatePending - activates the first interrupt pending and clears it. -*/ - -static unsigned int activatePending (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri, int maxFd, Selective_SetOfFd *inSet, Selective_SetOfFd *outSet, Selective_Timeval *timeval, Selective_Timeval b4, Selective_Timeval after); - -/* - init - -*/ - -static void init (void); - - -/* - Max - returns the maximum: i or j. -*/ - -static int Max (int i, int j) -{ - if (i > j) - { - return i; - } - else - { - return j; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -static int Min (int i, int j) -{ - /* - Max - returns the minimum: i or j. - */ - if (i < j) - { - return i; - } - else - { - return j; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FindVector - searches the exists list for a vector of type - which is associated with file descriptor, fd. -*/ - -static RTint_Vector FindVector (int fd, RTint_VectorType type) -{ - RTint_Vector vec; - - vec = Exists; - while (vec != NULL) - { - if ((vec->type == type) && (vec->File == fd)) - { - return vec; - } - vec = vec->exists; - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FindVectorNo - searches the Exists list for vector vec. -*/ - -static RTint_Vector FindVectorNo (unsigned int vec) -{ - RTint_Vector vptr; - - vptr = Exists; - while ((vptr != NULL) && (vptr->no != vec)) - { - vptr = vptr->exists; - } - return vptr; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FindPendingVector - searches the pending list for vector, vec. -*/ - -static RTint_Vector FindPendingVector (unsigned int vec) -{ - unsigned int pri; - RTint_Vector vptr; - - for (pri=COROUTINES_UnassignedPriority; pri<=7; pri++) - { - vptr = Pending.array[pri-(COROUTINES_UnassignedPriority)]; - while ((vptr != NULL) && (vptr->no != vec)) - { - vptr = vptr->pending; - } - if ((vptr != NULL) && (vptr->no == vec)) - { - return vptr; - } - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - AddFd - adds the file descriptor fd to set updating max. -*/ - -static void AddFd (Selective_SetOfFd *set, int *max, int fd) -{ - (*max) = Max (fd, (*max)); - if ((*set) == NULL) - { - (*set) = Selective_InitSet (); - Selective_FdZero ((*set)); - } - /* printf('%d, ', fd) */ - Selective_FdSet (fd, (*set)); -} - - -/* - DumpPendingQueue - displays the pending queue. -*/ - -static void DumpPendingQueue (void) -{ - COROUTINES_PROTECTION pri; - RTint_Vector vptr; - unsigned int sec; - unsigned int micro; - - libc_printf ((const char *) "Pending queue\\n", 15); - for (pri=COROUTINES_UnassignedPriority; pri<=7; pri++) - { - libc_printf ((const char *) "[%d] ", 6, pri); - vptr = Pending.array[pri-(COROUTINES_UnassignedPriority)]; - while (vptr != NULL) - { - if ((vptr->type == RTint_input) || (vptr->type == RTint_output)) - { - libc_printf ((const char *) "(fd=%d) (vec=%d)", 16, vptr->File, vptr->no); - } - else if (vptr->type == RTint_time) - { - /* avoid dangling else. */ - Selective_GetTime (vptr->rel, &sec, µ); - Assertion_Assert (micro < Microseconds); - libc_printf ((const char *) "time (%u.%06u secs) (arg = %p)\\n", 32, sec, micro, vptr->arg); - } - vptr = vptr->pending; - } - libc_printf ((const char *) " \\n", 3); - } -} - - -/* - AddTime - t1 := t1 + t2 -*/ - -static void AddTime (Selective_Timeval t1, Selective_Timeval t2) -{ - unsigned int a; - unsigned int b; - unsigned int s; - unsigned int m; - - Selective_GetTime (t1, &s, &m); - Assertion_Assert (m < Microseconds); - Selective_GetTime (t2, &a, &b); - Assertion_Assert (b < Microseconds); - a += s; - b += m; - if (b >= Microseconds) - { - b -= Microseconds; - a += 1; - } - Selective_SetTime (t1, a, b); -} - - -/* - IsGreaterEqual - returns TRUE if, a>=b -*/ - -static unsigned int IsGreaterEqual (Selective_Timeval a, Selective_Timeval b) -{ - unsigned int as; - unsigned int am; - unsigned int bs; - unsigned int bm; - - Selective_GetTime (a, &as, &am); - Assertion_Assert (am < Microseconds); - Selective_GetTime (b, &bs, &bm); - Assertion_Assert (bm < Microseconds); - return (as > bs) || ((as == bs) && (am >= bm)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SubTime - assigns, s and m, to a - b. -*/ - -static void SubTime (unsigned int *s, unsigned int *m, Selective_Timeval a, Selective_Timeval b) -{ - unsigned int as; - unsigned int am; - unsigned int bs; - unsigned int bm; - - Selective_GetTime (a, &as, &am); - Assertion_Assert (am < Microseconds); - Selective_GetTime (b, &bs, &bm); - Assertion_Assert (bm < Microseconds); - if (IsGreaterEqual (a, b)) - { - (*s) = as-bs; - if (am >= bm) - { - (*m) = am-bm; - Assertion_Assert ((*m) < Microseconds); - } - else - { - Assertion_Assert ((*s) > 0); - (*s) -= 1; - (*m) = (Microseconds+am)-bm; - Assertion_Assert ((*m) < Microseconds); - } - } - else - { - (*s) = 0; - (*m) = 0; - } -} - - -/* - activatePending - activates the first interrupt pending and clears it. -*/ - -static unsigned int activatePending (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri, int maxFd, Selective_SetOfFd *inSet, Selective_SetOfFd *outSet, Selective_Timeval *timeval, Selective_Timeval b4, Selective_Timeval after) -{ - int result; - unsigned int p; - RTint_Vector vec; - unsigned int b4s; - unsigned int b4m; - unsigned int afs; - unsigned int afm; - unsigned int sec; - unsigned int micro; - - RTco_wait (lock); - p = static_cast (7); - while (p > pri) - { - vec = Pending.array[p-(COROUTINES_UnassignedPriority)]; - while (vec != NULL) - { - switch (vec->type) - { - case RTint_input: - if (((vec->File < maxFd) && ((*inSet) != NULL)) && (Selective_FdIsSet (vec->File, (*inSet)))) - { - if (Debugging) - { - libc_printf ((const char *) "read (fd=%d) is ready (vec=%d)\\n", 32, vec->File, vec->no); - DumpPendingQueue (); - } - Selective_FdClr (vec->File, (*inSet)); /* so we dont activate this again from our select. */ - RTco_signal (lock); /* so we dont activate this again from our select. */ - (*call.proc) (vec->no, vec->priority, vec->arg); - return TRUE; - } - break; - - case RTint_output: - if (((vec->File < maxFd) && ((*outSet) != NULL)) && (Selective_FdIsSet (vec->File, (*outSet)))) - { - if (Debugging) - { - libc_printf ((const char *) "write (fd=%d) is ready (vec=%d)\\n", 33, vec->File, vec->no); - DumpPendingQueue (); - } - Selective_FdClr (vec->File, (*outSet)); /* so we dont activate this again from our select. */ - RTco_signal (lock); /* so we dont activate this again from our select. */ - (*call.proc) (vec->no, vec->priority, vec->arg); - return TRUE; - } - break; - - case RTint_time: - if (untilInterrupt && ((*timeval) != NULL)) - { - result = Selective_GetTimeOfDay (after); - Assertion_Assert (result == 0); - if (Debugging) - { - Selective_GetTime ((*timeval), &sec, µ); - Assertion_Assert (micro < Microseconds); - Selective_GetTime (after, &afs, &afm); - Assertion_Assert (afm < Microseconds); - Selective_GetTime (b4, &b4s, &b4m); - Assertion_Assert (b4m < Microseconds); - libc_printf ((const char *) "waited %u.%06u + %u.%06u now is %u.%06u\\n", 41, sec, micro, b4s, b4m, afs, afm); - } - if (IsGreaterEqual (after, vec->abs_)) - { - if (Debugging) - { - DumpPendingQueue (); - libc_printf ((const char *) "time has expired calling dispatcher\\n", 37); - } - (*timeval) = Selective_KillTime ((*timeval)); /* so we dont activate this again from our select. */ - RTco_signal (lock); /* so we dont activate this again from our select. */ - if (Debugging) - { - libc_printf ((const char *) "call (%d, %d, 0x%x)\\n", 21, vec->no, vec->priority, vec->arg); - } - (*call.proc) (vec->no, vec->priority, vec->arg); - return TRUE; - } - else if (Debugging) - { - /* avoid dangling else. */ - libc_printf ((const char *) "must wait longer as time has not expired\\n", 42); - } - } - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1); - __builtin_unreachable (); - } - vec = vec->pending; - } - p -= 1; - } - RTco_signal (lock); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - init - -*/ - -static void init (void) -{ - COROUTINES_PROTECTION p; - - lock = RTco_initSemaphore (1); - RTco_wait (lock); - Exists = NULL; - for (p=COROUTINES_UnassignedPriority; p<=7; p++) - { - Pending.array[p-(COROUTINES_UnassignedPriority)] = NULL; - } - initialized = TRUE; - RTco_signal (lock); -} - - -/* - InitInputVector - returns an interrupt vector which is associated - with the file descriptor, fd. -*/ - -extern "C" unsigned int RTint_InitInputVector (int fd, unsigned int pri) -{ - RTint_Vector vptr; - - if (Debugging) - { - libc_printf ((const char *) "InitInputVector fd = %d priority = %d\\n", 39, fd, pri); - } - RTco_wait (lock); - vptr = FindVector (fd, RTint_input); - if (vptr == NULL) - { - Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1)); - VecNo += 1; - vptr->type = RTint_input; - vptr->priority = pri; - vptr->arg = NULL; - vptr->pending = NULL; - vptr->exists = Exists; - vptr->no = VecNo; - vptr->File = fd; - Exists = vptr; - RTco_signal (lock); - return VecNo; - } - else - { - RTco_signal (lock); - return vptr->no; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitOutputVector - returns an interrupt vector which is associated - with the file descriptor, fd. -*/ - -extern "C" unsigned int RTint_InitOutputVector (int fd, unsigned int pri) -{ - RTint_Vector vptr; - - RTco_wait (lock); - vptr = FindVector (fd, RTint_output); - if (vptr == NULL) - { - Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1)); - if (vptr == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - VecNo += 1; - vptr->type = RTint_output; - vptr->priority = pri; - vptr->arg = NULL; - vptr->pending = NULL; - vptr->exists = Exists; - vptr->no = VecNo; - vptr->File = fd; - Exists = vptr; - RTco_signal (lock); - return VecNo; - } - } - else - { - RTco_signal (lock); - return vptr->no; - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1); - __builtin_unreachable (); -} - - -/* - InitTimeVector - returns an interrupt vector associated with - the relative time. -*/ - -extern "C" unsigned int RTint_InitTimeVector (unsigned int micro, unsigned int secs, unsigned int pri) -{ - RTint_Vector vptr; - - RTco_wait (lock); - Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1)); - if (vptr == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - VecNo += 1; - Assertion_Assert (micro < Microseconds); - vptr->type = RTint_time; - vptr->priority = pri; - vptr->arg = NULL; - vptr->pending = NULL; - vptr->exists = Exists; - vptr->no = VecNo; - vptr->rel = Selective_InitTime (secs+DebugTime, micro); - vptr->abs_ = Selective_InitTime (0, 0); - vptr->queued = FALSE; - Exists = vptr; - } - RTco_signal (lock); - return VecNo; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt - at the new relative time. -*/ - -extern "C" void RTint_ReArmTimeVector (unsigned int vec, unsigned int micro, unsigned int secs) -{ - RTint_Vector vptr; - - Assertion_Assert (micro < Microseconds); - RTco_wait (lock); - vptr = FindVectorNo (vec); - if (vptr == NULL) - { - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27); - } - else - { - Selective_SetTime (vptr->rel, secs+DebugTime, micro); - } - RTco_signal (lock); -} - - -/* - GetTimeVector - assigns, micro, and, secs, with the remaining - time before this interrupt will expire. - This value is only updated when a Listen - occurs. -*/ - -extern "C" void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsigned int *secs) -{ - RTint_Vector vptr; - - RTco_wait (lock); - vptr = FindVectorNo (vec); - if (vptr == NULL) - { - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27); - } - else - { - Selective_GetTime (vptr->rel, secs, micro); - Assertion_Assert ((*micro) < Microseconds); - } - RTco_signal (lock); -} - - -/* - AttachVector - adds the pointer ptr to be associated with the interrupt - vector. It returns the previous value attached to this - vector. -*/ - -extern "C" void * RTint_AttachVector (unsigned int vec, void * ptr) -{ - RTint_Vector vptr; - void * prevArg; - - RTco_wait (lock); - vptr = FindVectorNo (vec); - if (vptr == NULL) - { - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27); - } - else - { - prevArg = vptr->arg; - vptr->arg = ptr; - if (Debugging) - { - libc_printf ((const char *) "AttachVector %d with %p\\n", 25, vec, ptr); - DumpPendingQueue (); - } - RTco_signal (lock); - return prevArg; - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1); - __builtin_unreachable (); -} - - -/* - IncludeVector - includes, vec, into the dispatcher list of - possible interrupt causes. -*/ - -extern "C" void RTint_IncludeVector (unsigned int vec) -{ - RTint_Vector vptr; - unsigned int micro; - unsigned int sec; - int result; - - RTco_wait (lock); - vptr = FindPendingVector (vec); - if (vptr == NULL) - { - /* avoid dangling else. */ - vptr = FindVectorNo (vec); - if (vptr == NULL) - { - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27); - } - else - { - /* printf('including vector %d (fd = %d) - ', vec, v^.File) ; */ - vptr->pending = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)]; - Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] = vptr; - if ((vptr->type == RTint_time) && ! vptr->queued) - { - vptr->queued = TRUE; - result = Selective_GetTimeOfDay (vptr->abs_); - Assertion_Assert (result == 0); - Selective_GetTime (vptr->abs_, &sec, µ); - Assertion_Assert (micro < Microseconds); - AddTime (vptr->abs_, vptr->rel); - Selective_GetTime (vptr->abs_, &sec, µ); - Assertion_Assert (micro < Microseconds); - } - } - } - else - { - if (Debugging) - { - libc_printf ((const char *) "odd vector (%d) type (%d) arg (%p) is already attached to the pending queue\\n", 77, vec, vptr->type, vptr->arg); - } - } - RTco_signal (lock); -} - - -/* - ExcludeVector - excludes, vec, from the dispatcher list of - possible interrupt causes. -*/ - -extern "C" void RTint_ExcludeVector (unsigned int vec) -{ - RTint_Vector vptr; - RTint_Vector uptr; - - RTco_wait (lock); - vptr = FindPendingVector (vec); - if (vptr == NULL) - { - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 414, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35); - } - else - { - /* printf('excluding vector %d - ', vec) ; */ - if (Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] == vptr) - { - Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)]->pending; - } - else - { - uptr = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)]; - while (uptr->pending != vptr) - { - uptr = uptr->pending; - } - uptr->pending = vptr->pending; - } - if (vptr->type == RTint_time) - { - vptr->queued = FALSE; - } - } - RTco_signal (lock); -} - - -/* - Listen - will either block indefinitely (until an interrupt) - or alteratively will test to see whether any interrupts - are pending. - If a pending interrupt was found then, call, is called - and then this procedure returns. - It only listens for interrupts > pri. -*/ - -extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri) -{ - unsigned int found; - int result; - Selective_Timeval after; - Selective_Timeval b4; - Selective_Timeval timeval; - RTint_Vector vec; - Selective_SetOfFd inSet; - Selective_SetOfFd outSet; - unsigned int b4s; - unsigned int b4m; - unsigned int afs; - unsigned int afm; - unsigned int sec; - unsigned int micro; - int maxFd; - unsigned int p; - - RTco_wait (lock); - if (pri < (7)) - { - if (Debugging) - { - DumpPendingQueue (); - } - maxFd = -1; - timeval = NULL; - inSet = NULL; - outSet = NULL; - timeval = Selective_InitTime (static_cast (INT_MAX), 0); - p = static_cast (7); - found = FALSE; - while (p > pri) - { - vec = Pending.array[p-(COROUTINES_UnassignedPriority)]; - while (vec != NULL) - { - switch (vec->type) - { - case RTint_input: - AddFd (&inSet, &maxFd, vec->File); - break; - - case RTint_output: - AddFd (&outSet, &maxFd, vec->File); - break; - - case RTint_time: - if (IsGreaterEqual (timeval, vec->abs_)) - { - Selective_GetTime (vec->abs_, &sec, µ); - Assertion_Assert (micro < Microseconds); - if (Debugging) - { - libc_printf ((const char *) "shortest delay is %u.%06u\\n", 27, sec, micro); - } - Selective_SetTime (timeval, sec, micro); - found = TRUE; - } - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1); - __builtin_unreachable (); - } - vec = vec->pending; - } - p -= 1; - } - if (! untilInterrupt) - { - Selective_SetTime (timeval, 0, 0); - } - if (((untilInterrupt && (inSet == NULL)) && (outSet == NULL)) && ! found) - { - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 730, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65); - } - /* printf('} - ') ; */ - if (((! found && (maxFd == -1)) && (inSet == NULL)) && (outSet == NULL)) - { - /* no file descriptors to be selected upon. */ - timeval = Selective_KillTime (timeval); - RTco_signal (lock); - return ; - } - else - { - Selective_GetTime (timeval, &sec, µ); - Assertion_Assert (micro < Microseconds); - b4 = Selective_InitTime (0, 0); - after = Selective_InitTime (0, 0); - result = Selective_GetTimeOfDay (b4); - Assertion_Assert (result == 0); - SubTime (&sec, µ, timeval, b4); - Selective_SetTime (timeval, sec, micro); - if (Debugging) - { - libc_printf ((const char *) "select waiting for %u.%06u seconds\\n", 36, sec, micro); - } - RTco_signal (lock); - do { - if (Debugging) - { - libc_printf ((const char *) "select (.., .., .., %u.%06u)\\n", 30, sec, micro); - } - result = RTco_select (maxFd+1, inSet, outSet, NULL, timeval); - if (result == -1) - { - libc_perror ((const char *) "select", 6); - result = RTco_select (maxFd+1, inSet, outSet, NULL, NULL); - if (result == -1) - { - libc_perror ((const char *) "select timeout argument is faulty", 33); - } - result = RTco_select (maxFd+1, inSet, NULL, NULL, timeval); - if (result == -1) - { - libc_perror ((const char *) "select output fd argument is faulty", 35); - } - result = RTco_select (maxFd+1, NULL, outSet, NULL, timeval); - if (result == -1) - { - libc_perror ((const char *) "select input fd argument is faulty", 34); - } - else - { - libc_perror ((const char *) "select maxFD+1 argument is faulty", 33); - } - } - } while (! (result != -1)); - } - while (activatePending (untilInterrupt, call, pri, maxFd+1, &inSet, &outSet, &timeval, b4, after)) - {} /* empty. */ - if (timeval != NULL) - { - timeval = Selective_KillTime (timeval); - } - if (after != NULL) - { - after = Selective_KillTime (after); - } - if (b4 != NULL) - { - b4 = Selective_KillTime (b4); - } - if (inSet != NULL) - { - inSet = Selective_KillSet (inSet); - } - if (outSet != NULL) - { - outSet = Selective_KillSet (outSet); - } - } - RTco_signal (lock); -} - - -/* - Init - -*/ - -extern "C" void RTint_Init (void) -{ - if (! initialized) - { - init (); - } -} - -extern "C" void _M2_RTint_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - RTint_Init (); -} - -extern "C" void _M2_RTint_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GSArgs.c b/gcc/m2/mc-boot/GSArgs.c deleted file mode 100644 index 143d2783c16e..000000000000 --- a/gcc/m2/mc-boot/GSArgs.c +++ /dev/null @@ -1,125 +0,0 @@ -/* do not edit automatically generated by mc from SArgs. */ -/* SArgs.mod provides a String interface to the command line arguments. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _SArgs_H -#define _SArgs_C - -# include "GSYSTEM.h" -# include "GUnixArgs.h" -# include "GDynamicStrings.h" - -typedef char *SArgs_PtrToChar; - -typedef SArgs_PtrToChar *SArgs_PtrToPtrToChar; - - -/* - GetArg - returns the nth argument from the command line. - The success of the operation is returned. - If TRUE is returned then the string, s, contains a - new string, otherwise s is set to NIL. -*/ - -extern "C" unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int n); - -/* - Narg - returns the number of arguments available from - command line. -*/ - -extern "C" unsigned int SArgs_Narg (void); - - -/* - GetArg - returns the nth argument from the command line. - The success of the operation is returned. - If TRUE is returned then the string, s, contains a - new string, otherwise s is set to NIL. -*/ - -extern "C" unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int n) -{ - int i; - SArgs_PtrToPtrToChar ppc; - - i = (int ) (n); - if (i < (UnixArgs_GetArgC ())) - { - /* ppc := ADDRESS (VAL (PtrToPtrToChar, ArgV) + (i * CARDINAL (TSIZE(PtrToChar)))) ; */ - ppc = static_cast ((void *) (((SArgs_PtrToChar) (UnixArgs_GetArgV ()))+(n*sizeof (SArgs_PtrToChar)))); - (*s) = DynamicStrings_InitStringCharStar (reinterpret_cast ((*ppc))); - return TRUE; - } - else - { - (*s) = static_cast (NULL); - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Narg - returns the number of arguments available from - command line. -*/ - -extern "C" unsigned int SArgs_Narg (void) -{ - return UnixArgs_GetArgC (); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_SArgs_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_SArgs_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GSFIO.c b/gcc/m2/mc-boot/GSFIO.c deleted file mode 100644 index 1a800138812c..000000000000 --- a/gcc/m2/mc-boot/GSFIO.c +++ /dev/null @@ -1,216 +0,0 @@ -/* do not edit automatically generated by mc from SFIO. */ -/* SFIO.mod provides a String interface to the opening routines of FIO. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _SFIO_H -#define _SFIO_C - -# include "GASCII.h" -# include "GDynamicStrings.h" -# include "GFIO.h" - - -/* - Exists - returns TRUE if a file named, fname exists for reading. -*/ - -extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname); - -/* - OpenToRead - attempts to open a file, fname, for reading and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname); - -/* - OpenToWrite - attempts to open a file, fname, for write and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname); - -/* - OpenForRandom - attempts to open a file, fname, for random access - read or write and it returns this file. - The success of this operation can be checked by - calling IsNoError. - towrite, determines whether the file should be - opened for writing or reading. - if towrite is TRUE or whether the previous file should - be left alone, allowing this descriptor to seek - and modify an existing file. -*/ - -extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile); - -/* - WriteS - writes a string, s, to, file. It returns the String, s. -*/ - -extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s); - -/* - ReadS - reads and returns a string from, file. - It stops reading the string at the end of line or end of file. - It consumes the newline at the end of line but does not place - this into the returned string. -*/ - -extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file); - - -/* - Exists - returns TRUE if a file named, fname exists for reading. -*/ - -extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname) -{ - return FIO_exists (DynamicStrings_string (fname), DynamicStrings_Length (fname)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OpenToRead - attempts to open a file, fname, for reading and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname) -{ - return FIO_openToRead (DynamicStrings_string (fname), DynamicStrings_Length (fname)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OpenToWrite - attempts to open a file, fname, for write and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname) -{ - return FIO_openToWrite (DynamicStrings_string (fname), DynamicStrings_Length (fname)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OpenForRandom - attempts to open a file, fname, for random access - read or write and it returns this file. - The success of this operation can be checked by - calling IsNoError. - towrite, determines whether the file should be - opened for writing or reading. - if towrite is TRUE or whether the previous file should - be left alone, allowing this descriptor to seek - and modify an existing file. -*/ - -extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile) -{ - return FIO_openForRandom (DynamicStrings_string (fname), DynamicStrings_Length (fname), towrite, newfile); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WriteS - writes a string, s, to, file. It returns the String, s. -*/ - -extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s) -{ - unsigned int nBytes; - - if (s != NULL) - { - nBytes = FIO_WriteNBytes (file, DynamicStrings_Length (s), DynamicStrings_string (s)); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ReadS - reads and returns a string from, file. - It stops reading the string at the end of line or end of file. - It consumes the newline at the end of line but does not place - this into the returned string. -*/ - -extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file) -{ - DynamicStrings_String s; - unsigned int c; - - s = DynamicStrings_InitString ((const char *) "", 0); - while (((! (FIO_EOLN (file))) && (! (FIO_EOF (file)))) && (FIO_IsNoError (file))) - { - s = DynamicStrings_ConCatChar (s, FIO_ReadChar (file)); - } - if (FIO_EOLN (file)) - { - /* consume nl */ - if ((FIO_ReadChar (file)) == ASCII_nul) - {} /* empty. */ - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_SFIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_SFIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GStdIO.c b/gcc/m2/mc-boot/GStdIO.c deleted file mode 100644 index 41affe2a054d..000000000000 --- a/gcc/m2/mc-boot/GStdIO.c +++ /dev/null @@ -1,269 +0,0 @@ -/* do not edit automatically generated by mc from StdIO. */ -/* StdIO.mod provides general Read and Write procedures. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# include "Gmcrts.h" -#define _StdIO_H -#define _StdIO_C - -# include "GIO.h" -# include "GM2RTS.h" - -typedef struct StdIO_ProcWrite_p StdIO_ProcWrite; - -typedef struct StdIO_ProcRead_p StdIO_ProcRead; - -# define MaxStack 40 -typedef struct StdIO__T1_a StdIO__T1; - -typedef struct StdIO__T2_a StdIO__T2; - -typedef void (*StdIO_ProcWrite_t) (char); -struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; }; - -typedef void (*StdIO_ProcRead_t) (char *); -struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; }; - -struct StdIO__T1_a { StdIO_ProcWrite array[MaxStack+1]; }; -struct StdIO__T2_a { StdIO_ProcRead array[MaxStack+1]; }; -static StdIO__T1 StackW; -static unsigned int StackWPtr; -static StdIO__T2 StackR; -static unsigned int StackRPtr; - -/* - Read - is the generic procedure that all higher application layers - should use to receive a character. -*/ - -extern "C" void StdIO_Read (char *ch); - -/* - Write - is the generic procedure that all higher application layers - should use to emit a character. -*/ - -extern "C" void StdIO_Write (char ch); - -/* - PushOutput - pushes the current Write procedure onto a stack, - any future references to Write will actually invoke - procedure, p. -*/ - -extern "C" void StdIO_PushOutput (StdIO_ProcWrite p); - -/* - PopOutput - restores Write to use the previous output procedure. -*/ - -extern "C" void StdIO_PopOutput (void); - -/* - GetCurrentOutput - returns the current output procedure. -*/ - -extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void); - -/* - PushInput - pushes the current Read procedure onto a stack, - any future references to Read will actually invoke - procedure, p. -*/ - -extern "C" void StdIO_PushInput (StdIO_ProcRead p); - -/* - PopInput - restores Write to use the previous output procedure. -*/ - -extern "C" void StdIO_PopInput (void); - -/* - GetCurrentInput - returns the current input procedure. -*/ - -extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void); - - -/* - Read - is the generic procedure that all higher application layers - should use to receive a character. -*/ - -extern "C" void StdIO_Read (char *ch) -{ - (*StackR.array[StackRPtr].proc) (ch); -} - - -/* - Write - is the generic procedure that all higher application layers - should use to emit a character. -*/ - -extern "C" void StdIO_Write (char ch) -{ - (*StackW.array[StackWPtr].proc) (ch); -} - - -/* - PushOutput - pushes the current Write procedure onto a stack, - any future references to Write will actually invoke - procedure, p. -*/ - -extern "C" void StdIO_PushOutput (StdIO_ProcWrite p) -{ - if (StackWPtr == MaxStack) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - StackWPtr += 1; - StackW.array[StackWPtr] = p; - } -} - - -/* - PopOutput - restores Write to use the previous output procedure. -*/ - -extern "C" void StdIO_PopOutput (void) -{ - if (StackWPtr == 1) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - StackWPtr -= 1; - } -} - - -/* - GetCurrentOutput - returns the current output procedure. -*/ - -extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void) -{ - if (StackWPtr > 0) - { - return StackW.array[StackWPtr]; - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1); - __builtin_unreachable (); -} - - -/* - PushInput - pushes the current Read procedure onto a stack, - any future references to Read will actually invoke - procedure, p. -*/ - -extern "C" void StdIO_PushInput (StdIO_ProcRead p) -{ - if (StackRPtr == MaxStack) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - StackRPtr += 1; - StackR.array[StackRPtr] = p; - } -} - - -/* - PopInput - restores Write to use the previous output procedure. -*/ - -extern "C" void StdIO_PopInput (void) -{ - if (StackRPtr == 1) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - StackRPtr -= 1; - } -} - - -/* - GetCurrentInput - returns the current input procedure. -*/ - -extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void) -{ - if (StackRPtr > 0) - { - return StackR.array[StackRPtr]; - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1); - __builtin_unreachable (); -} - -extern "C" void _M2_StdIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - StackWPtr = 0; - StackRPtr = 0; - StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) IO_Write}); - StdIO_PushInput ((StdIO_ProcRead) {(StdIO_ProcRead_t) IO_Read}); -} - -extern "C" void _M2_StdIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GStorage.c b/gcc/m2/mc-boot/GStorage.c deleted file mode 100644 index 5dac021d8665..000000000000 --- a/gcc/m2/mc-boot/GStorage.c +++ /dev/null @@ -1,74 +0,0 @@ -/* do not edit automatically generated by mc from Storage. */ -/* Storage.mod provides access to the dynamic Storage handler. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _Storage_H -#define _Storage_C - -# include "GSysStorage.h" - -extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size); -extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size); -extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size); -extern "C" unsigned int Storage_Available (unsigned int Size); - -extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size) -{ - SysStorage_ALLOCATE (a, Size); -} - -extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size) -{ - SysStorage_DEALLOCATE (a, Size); -} - -extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size) -{ - SysStorage_REALLOCATE (a, Size); -} - -extern "C" unsigned int Storage_Available (unsigned int Size) -{ - return SysStorage_Available (Size); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_Storage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Storage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GStrCase.c b/gcc/m2/mc-boot/GStrCase.c deleted file mode 100644 index e3491b6d75b1..000000000000 --- a/gcc/m2/mc-boot/GStrCase.c +++ /dev/null @@ -1,175 +0,0 @@ -/* do not edit automatically generated by mc from StrCase. */ -/* StrCase.mod provides procedure to convert between text case. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _StrCase_H -#define _StrCase_C - -# include "GASCII.h" -# include "GStrLib.h" - - -/* - StrToUpperCase - converts string, a, to uppercase returning the - result in, b. -*/ - -extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high); - -/* - StrToLowerCase - converts string, a, to lowercase returning the - result in, b. -*/ - -extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high); - -/* - Cap - converts a lower case character into a capital character. - If the character is not a lower case character 'a'..'z' - then the character is simply returned unaltered. -*/ - -extern "C" char StrCase_Cap (char ch); - -/* - Lower - converts an upper case character into a lower case character. - If the character is not an upper case character 'A'..'Z' - then the character is simply returned unaltered. -*/ - -extern "C" char StrCase_Lower (char ch); - - -/* - StrToUpperCase - converts string, a, to uppercase returning the - result in, b. -*/ - -extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high) -{ - unsigned int higha; - unsigned int highb; - unsigned int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - higha = StrLib_StrLen ((const char *) a, _a_high); - highb = _b_high; - i = 0; - while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb)) - { - b[i] = StrCase_Cap (a[i]); - i += 1; - } - if (i < highb) - { - b[i] = ASCII_nul; - } -} - - -/* - StrToLowerCase - converts string, a, to lowercase returning the - result in, b. -*/ - -extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high) -{ - unsigned int higha; - unsigned int highb; - unsigned int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - higha = StrLib_StrLen ((const char *) a, _a_high); - highb = _b_high; - i = 0; - while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb)) - { - b[i] = StrCase_Lower (a[i]); - i += 1; - } - if (i < highb) - { - b[i] = ASCII_nul; - } -} - - -/* - Cap - converts a lower case character into a capital character. - If the character is not a lower case character 'a'..'z' - then the character is simply returned unaltered. -*/ - -extern "C" char StrCase_Cap (char ch) -{ - if ((ch >= 'a') && (ch <= 'z')) - { - ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A')))); - } - return ch; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Lower - converts an upper case character into a lower case character. - If the character is not an upper case character 'A'..'Z' - then the character is simply returned unaltered. -*/ - -extern "C" char StrCase_Lower (char ch) -{ - if ((ch >= 'A') && (ch <= 'Z')) - { - ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a')))); - } - return ch; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_StrCase_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_StrCase_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GStrIO.c b/gcc/m2/mc-boot/GStrIO.c deleted file mode 100644 index 1e091bce5456..000000000000 --- a/gcc/m2/mc-boot/GStrIO.c +++ /dev/null @@ -1,277 +0,0 @@ -/* do not edit automatically generated by mc from StrIO. */ -/* StrIO.mod provides simple string input output routines. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#define _StrIO_H -#define _StrIO_C - -# include "GASCII.h" -# include "GStdIO.h" -# include "Glibc.h" - -static unsigned int IsATTY; - -/* - WriteLn - writes a carriage return and a newline - character. -*/ - -extern "C" void StrIO_WriteLn (void); - -/* - ReadString - reads a sequence of characters into a string. - Line editing accepts Del, Ctrl H, Ctrl W and - Ctrl U. -*/ - -extern "C" void StrIO_ReadString (char *a, unsigned int _a_high); - -/* - WriteString - writes a string to the default output. -*/ - -extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high); - -/* - Erase - writes a backspace, space and backspace to remove the - last character displayed. -*/ - -static void Erase (void); - -/* - Echo - echos the character, ch, onto the output channel if IsATTY - is true. -*/ - -static void Echo (char ch); - -/* - AlphaNum- returns true if character, ch, is an alphanumeric character. -*/ - -static unsigned int AlphaNum (char ch); - - -/* - Erase - writes a backspace, space and backspace to remove the - last character displayed. -*/ - -static void Erase (void) -{ - Echo (ASCII_bs); - Echo (' '); - Echo (ASCII_bs); -} - - -/* - Echo - echos the character, ch, onto the output channel if IsATTY - is true. -*/ - -static void Echo (char ch) -{ - if (IsATTY) - { - StdIO_Write (ch); - } -} - - -/* - AlphaNum- returns true if character, ch, is an alphanumeric character. -*/ - -static unsigned int AlphaNum (char ch) -{ - return (((ch >= 'a') && (ch <= 'z')) || ((ch >= 'A') && (ch <= 'Z'))) || ((ch >= '0') && (ch <= '9')); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WriteLn - writes a carriage return and a newline - character. -*/ - -extern "C" void StrIO_WriteLn (void) -{ - Echo (ASCII_cr); - StdIO_Write (ASCII_lf); -} - - -/* - ReadString - reads a sequence of characters into a string. - Line editing accepts Del, Ctrl H, Ctrl W and - Ctrl U. -*/ - -extern "C" void StrIO_ReadString (char *a, unsigned int _a_high) -{ - unsigned int n; - unsigned int high; - char ch; - - high = _a_high; - n = 0; - do { - StdIO_Read (&ch); - if ((ch == ASCII_del) || (ch == ASCII_bs)) - { - if (n == 0) - { - StdIO_Write (ASCII_bel); - } - else - { - Erase (); - n -= 1; - } - } - else if (ch == ASCII_nak) - { - /* avoid dangling else. */ - while (n > 0) - { - Erase (); - n -= 1; - } - } - else if (ch == ASCII_etb) - { - /* avoid dangling else. */ - if (n == 0) - { - Echo (ASCII_bel); - } - else if (AlphaNum (a[n-1])) - { - /* avoid dangling else. */ - do { - Erase (); - n -= 1; - } while (! ((n == 0) || (! (AlphaNum (a[n-1]))))); - } - else - { - /* avoid dangling else. */ - Erase (); - n -= 1; - } - } - else if (n <= high) - { - /* avoid dangling else. */ - if ((ch == ASCII_cr) || (ch == ASCII_lf)) - { - a[n] = ASCII_nul; - n += 1; - } - else if (ch == ASCII_ff) - { - /* avoid dangling else. */ - a[0] = ch; - if (high > 0) - { - a[1] = ASCII_nul; - } - ch = ASCII_cr; - } - else if (ch >= ' ') - { - /* avoid dangling else. */ - Echo (ch); - a[n] = ch; - n += 1; - } - else if (ch == ASCII_eof) - { - /* avoid dangling else. */ - a[n] = ch; - n += 1; - ch = ASCII_cr; - if (n <= high) - { - a[n] = ASCII_nul; - } - } - } - else if (ch != ASCII_cr) - { - /* avoid dangling else. */ - Echo (ASCII_bel); - } - } while (! ((ch == ASCII_cr) || (ch == ASCII_lf))); -} - - -/* - WriteString - writes a string to the default output. -*/ - -extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high) -{ - unsigned int n; - unsigned int high; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - high = _a_high; - n = 0; - while ((n <= high) && (a[n] != ASCII_nul)) - { - StdIO_Write (a[n]); - n += 1; - } -} - -extern "C" void _M2_StrIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - /* IsATTY := isatty() */ - IsATTY = FALSE; -} - -extern "C" void _M2_StrIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GStrLib.c b/gcc/m2/mc-boot/GStrLib.c deleted file mode 100644 index 537eeb963567..000000000000 --- a/gcc/m2/mc-boot/GStrLib.c +++ /dev/null @@ -1,346 +0,0 @@ -/* do not edit automatically generated by mc from StrLib. */ -/* StrLib.mod provides string manipulation procedures. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#define _StrLib_H -#define _StrLib_C - -# include "GASCII.h" - - -/* - StrConCat - combines a and b into c. -*/ - -extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high); - -/* - StrLess - returns TRUE if string, a, alphabetically occurs before - string, b. -*/ - -extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); -extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); -extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high); - -/* - StrCopy - copy string src into string dest providing dest is large enough. - If dest is smaller than a then src then the string is truncated when - dest is full. Add a nul character if there is room in dest. -*/ - -extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high); - -/* - IsSubString - returns true if b is a subcomponent of a. -*/ - -extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); - -/* - StrRemoveWhitePrefix - copies string, into string, b, excluding any white - space infront of a. -*/ - -extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high); - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch); - - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch) -{ - return (ch == ' ') || (ch == ASCII_tab); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StrConCat - combines a and b into c. -*/ - -extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high) -{ - unsigned int Highb; - unsigned int Highc; - unsigned int i; - unsigned int j; - char a[_a_high+1]; - char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - Highb = StrLib_StrLen ((const char *) b, _b_high); - Highc = _c_high; - StrLib_StrCopy ((const char *) a, _a_high, (char *) c, _c_high); - i = StrLib_StrLen ((const char *) c, _c_high); - j = 0; - while ((j < Highb) && (i <= Highc)) - { - c[i] = b[j]; - i += 1; - j += 1; - } - if (i <= Highc) - { - c[i] = ASCII_nul; - } -} - - -/* - StrLess - returns TRUE if string, a, alphabetically occurs before - string, b. -*/ - -extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high) -{ - unsigned int Higha; - unsigned int Highb; - unsigned int i; - char a[_a_high+1]; - char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - Higha = StrLib_StrLen ((const char *) a, _a_high); - Highb = StrLib_StrLen ((const char *) b, _b_high); - i = 0; - while ((i < Higha) && (i < Highb)) - { - if (a[i] < b[i]) - { - return TRUE; - } - else if (a[i] > b[i]) - { - /* avoid dangling else. */ - return FALSE; - } - /* must be equal, move on to next character */ - i += 1; - } - return Higha < Highb; /* substrings are equal so we go on length */ - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned int higha; - unsigned int highb; - char a[_a_high+1]; - char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - higha = _a_high; - highb = _b_high; - i = 0; - while ((((i <= higha) && (i <= highb)) && (a[i] != ASCII_nul)) && (b[i] != ASCII_nul)) - { - if (a[i] != b[i]) - { - return FALSE; - } - i += 1; - } - return ! (((i <= higha) && (a[i] != ASCII_nul)) || ((i <= highb) && (b[i] != ASCII_nul))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high) -{ - unsigned int High; - unsigned int Len; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - Len = 0; - High = _a_high; - while ((Len <= High) && (a[Len] != ASCII_nul)) - { - Len += 1; - } - return Len; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StrCopy - copy string src into string dest providing dest is large enough. - If dest is smaller than a then src then the string is truncated when - dest is full. Add a nul character if there is room in dest. -*/ - -extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high) -{ - unsigned int HighSrc; - unsigned int HighDest; - unsigned int n; - char src[_src_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (src, src_, _src_high+1); - - n = 0; - HighSrc = StrLib_StrLen ((const char *) src, _src_high); - HighDest = _dest_high; - while ((n < HighSrc) && (n <= HighDest)) - { - dest[n] = src[n]; - n += 1; - } - if (n <= HighDest) - { - dest[n] = ASCII_nul; - } -} - - -/* - IsSubString - returns true if b is a subcomponent of a. -*/ - -extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned int j; - unsigned int LengthA; - unsigned int LengthB; - char a[_a_high+1]; - char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - LengthA = StrLib_StrLen ((const char *) a, _a_high); - LengthB = StrLib_StrLen ((const char *) b, _b_high); - i = 0; - if (LengthA > LengthB) - { - while (i <= (LengthA-LengthB)) - { - j = 0; - while ((j < LengthB) && (a[i+j] == b[j])) - { - j += 1; - } - if (j == LengthB) - { - return TRUE; - } - else - { - i += 1; - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StrRemoveWhitePrefix - copies string, into string, b, excluding any white - space infront of a. -*/ - -extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high) -{ - unsigned int i; - unsigned int j; - unsigned int higha; - unsigned int highb; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = 0; - j = 0; - higha = StrLib_StrLen ((const char *) a, _a_high); - highb = _b_high; - while ((i < higha) && (IsWhite (a[i]))) - { - i += 1; - } - while ((i < higha) && (j <= highb)) - { - b[j] = a[i]; - i += 1; - j += 1; - } - if (j <= highb) - { - b[j] = ASCII_nul; - } -} - -extern "C" void _M2_StrLib_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_StrLib_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GStringConvert.c b/gcc/m2/mc-boot/GStringConvert.c deleted file mode 100644 index faa5e34459ec..000000000000 --- a/gcc/m2/mc-boot/GStringConvert.c +++ /dev/null @@ -1,2005 +0,0 @@ -/* do not edit automatically generated by mc from StringConvert. */ -/* StringConvert.mod provides functions to convert numbers to and from strings. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _StringConvert_H -#define _StringConvert_C - -# include "GSYSTEM.h" -# include "Glibc.h" -# include "Glibm.h" -# include "GM2RTS.h" -# include "GDynamicStrings.h" -# include "Gldtoa.h" -# include "Gdtoa.h" - - -/* - IntegerToString - converts INTEGER, i, into a String. The field with can be specified - if non zero. Leading characters are defined by padding and this - function will prepend a + if sign is set to TRUE. - The base allows the caller to generate binary, octal, decimal, hexidecimal - numbers. The value of lower is only used when hexidecimal numbers are - generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF - are used. -*/ - -extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower); - -/* - CardinalToString - converts CARDINAL, c, into a String. The field with can be specified - if non zero. Leading characters are defined by padding. - The base allows the caller to generate binary, octal, decimal, hexidecimal - numbers. The value of lower is only used when hexidecimal numbers are - generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF - are used. -*/ - -extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); - -/* - StringToInteger - converts a string, s, of, base, into an INTEGER. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found); - -/* - StringToCardinal - converts a string, s, of, base, into a CARDINAL. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); - -/* - LongIntegerToString - converts LONGINT, i, into a String. The field with - can be specified if non zero. Leading characters - are defined by padding and this function will - prepend a + if sign is set to TRUE. - The base allows the caller to generate binary, - octal, decimal, hexidecimal numbers. - The value of lower is only used when hexidecimal - numbers are generated and if TRUE then digits - abcdef are used, and if FALSE then ABCDEF are used. -*/ - -extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower); - -/* - StringToLongInteger - converts a string, s, of, base, into an LONGINT. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found); - -/* - LongCardinalToString - converts LONGCARD, c, into a String. The field - width can be specified if non zero. Leading - characters are defined by padding. - The base allows the caller to generate binary, - octal, decimal, hexidecimal numbers. - The value of lower is only used when hexidecimal - numbers are generated and if TRUE then digits - abcdef are used, and if FALSE then ABCDEF are used. -*/ - -extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); - -/* - StringToLongCardinal - converts a string, s, of, base, into a LONGCARD. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); - -/* - ShortCardinalToString - converts SHORTCARD, c, into a String. The field - width can be specified if non zero. Leading - characters are defined by padding. - The base allows the caller to generate binary, - octal, decimal, hexidecimal numbers. - The value of lower is only used when hexidecimal - numbers are generated and if TRUE then digits - abcdef are used, and if FALSE then ABCDEF are used. -*/ - -extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); - -/* - StringToShortCardinal - converts a string, s, of, base, into a SHORTCARD. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); - -/* - stoi - decimal string to INTEGER -*/ - -extern "C" int StringConvert_stoi (DynamicStrings_String s); - -/* - itos - integer to decimal string. -*/ - -extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign); - -/* - ctos - cardinal to decimal string. -*/ - -extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding); - -/* - stoc - decimal string to CARDINAL -*/ - -extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s); - -/* - hstoi - hexidecimal string to INTEGER -*/ - -extern "C" int StringConvert_hstoi (DynamicStrings_String s); - -/* - ostoi - octal string to INTEGER -*/ - -extern "C" int StringConvert_ostoi (DynamicStrings_String s); - -/* - bstoi - binary string to INTEGER -*/ - -extern "C" int StringConvert_bstoi (DynamicStrings_String s); - -/* - hstoc - hexidecimal string to CARDINAL -*/ - -extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s); - -/* - ostoc - octal string to CARDINAL -*/ - -extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s); - -/* - bstoc - binary string to CARDINAL -*/ - -extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s); - -/* - StringToLongreal - returns a LONGREAL and sets found to TRUE if a legal number is seen. -*/ - -extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found); - -/* - LongrealToString - converts a LONGREAL number, Real, which has, - TotalWidth, and FractionWidth into a string. - It uses decimal notation. - - So for example: - - LongrealToString(1.0, 4, 2) -> '1.00' - LongrealToString(12.3, 5, 2) -> '12.30' - LongrealToString(12.3, 6, 2) -> ' 12.30' - LongrealToString(12.3, 6, 3) -> '12.300' - - if total width is too small then the fraction - becomes truncated. - - LongrealToString(12.3, 5, 3) -> '12.30' - - Positive numbers do not have a '+' prepended. - Negative numbers will have a '-' prepended and - the TotalWidth will need to be large enough - to contain the sign, whole number, '.' and - fractional components. -*/ - -extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth); - -/* - stor - returns a REAL given a string. -*/ - -extern "C" double StringConvert_stor (DynamicStrings_String s); - -/* - stolr - returns a LONGREAL given a string. -*/ - -extern "C" long double StringConvert_stolr (DynamicStrings_String s); - -/* - ToSigFig - returns a floating point or base 10 integer - string which is accurate to, n, significant - figures. It will return a new String - and, s, will be destroyed. - - - So: 12.345 - - rounded to the following significant figures yields - - 5 12.345 - 4 12.34 - 3 12.3 - 2 12 - 1 10 -*/ - -extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n); - -/* - ToDecimalPlaces - returns a floating point or base 10 integer - string which is accurate to, n, decimal - places. It will return a new String - and, s, will be destroyed. - Decimal places yields, n, digits after - the . - - So: 12.345 - - rounded to the following decimal places yields - - 5 12.34500 - 4 12.3450 - 3 12.345 - 2 12.34 - 1 12.3 -*/ - -extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n); - -/* - Assert - implement a simple assert. -*/ - -static void Assert (unsigned int b, const char *file_, unsigned int _file_high, unsigned int line, const char *func_, unsigned int _func_high); - -/* - Max - -*/ - -static unsigned int Max (unsigned int a, unsigned int b); - -/* - Min - -*/ - -static unsigned int Min (unsigned int a, unsigned int b); - -/* - LongMin - returns the smallest LONGCARD -*/ - -static long unsigned int LongMin (long unsigned int a, long unsigned int b); - -/* - IsDigit - returns TRUE if, ch, lies between '0'..'9'. -*/ - -static unsigned int IsDigit (char ch); - -/* - IsDecimalDigitValid - returns the TRUE if, ch, is a base legal decimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsDecimalDigitValid (char ch, unsigned int base, unsigned int *c); - -/* - IsHexidecimalDigitValid - returns the TRUE if, ch, is a base legal hexidecimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsHexidecimalDigitValid (char ch, unsigned int base, unsigned int *c); - -/* - IsDecimalDigitValidLong - returns the TRUE if, ch, is a base legal decimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsDecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c); - -/* - IsHexidecimalDigitValidLong - returns the TRUE if, ch, is a base legal hexidecimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsHexidecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c); - -/* - IsDecimalDigitValidShort - returns the TRUE if, ch, is a base legal decimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsDecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c); - -/* - IsHexidecimalDigitValidShort - returns the TRUE if, ch, is a base legal hexidecimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsHexidecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c); - -/* - ToThePower10 - returns a LONGREAL containing the value of v * 10^power. -*/ - -static long double ToThePower10 (long double v, int power); - -/* - DetermineSafeTruncation - we wish to use TRUNC when converting REAL/LONGREAL - into a string for the non fractional component. - However we need a simple method to - determine the maximum safe truncation value. -*/ - -static unsigned int DetermineSafeTruncation (void); - -/* - rtos - -*/ - -static DynamicStrings_String rtos (double r, unsigned int TotalWidth, unsigned int FractionWidth); - -/* - lrtos - -*/ - -static DynamicStrings_String lrtos (long double r, unsigned int TotalWidth, unsigned int FractionWidth); - -/* - doDecimalPlaces - returns a string which is accurate to - n decimal places. It returns a new String - and, s, will be destroyed. -*/ - -static DynamicStrings_String doDecimalPlaces (DynamicStrings_String s, unsigned int n); - -/* - doSigFig - returns a string which is accurate to - n decimal places. It returns a new String - and, s, will be destroyed. -*/ - -static DynamicStrings_String doSigFig (DynamicStrings_String s, unsigned int n); - -/* - carryOne - add a carry at position, i. -*/ - -static DynamicStrings_String carryOne (DynamicStrings_String s, unsigned int i); - - -/* - Assert - implement a simple assert. -*/ - -static void Assert (unsigned int b, const char *file_, unsigned int _file_high, unsigned int line, const char *func_, unsigned int _func_high) -{ - char file[_file_high+1]; - char func[_func_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - memcpy (func, func_, _func_high+1); - - if (! b) - { - M2RTS_ErrorMessage ((const char *) "assert failed", 13, (const char *) file, _file_high, line, (const char *) func, _func_high); - } -} - - -/* - Max - -*/ - -static unsigned int Max (unsigned int a, unsigned int b) -{ - if (a > b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Min - -*/ - -static unsigned int Min (unsigned int a, unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - LongMin - returns the smallest LONGCARD -*/ - -static long unsigned int LongMin (long unsigned int a, long unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsDigit - returns TRUE if, ch, lies between '0'..'9'. -*/ - -static unsigned int IsDigit (char ch) -{ - return (ch >= '0') && (ch <= '9'); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsDecimalDigitValid - returns the TRUE if, ch, is a base legal decimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsDecimalDigitValid (char ch, unsigned int base, unsigned int *c) -{ - if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base)) - { - (*c) = ((*c)*base)+( ((unsigned int) (ch))- ((unsigned int) ('0'))); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsHexidecimalDigitValid - returns the TRUE if, ch, is a base legal hexidecimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsHexidecimalDigitValid (char ch, unsigned int base, unsigned int *c) -{ - if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base)) - { - (*c) = ((*c)*base)+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10); - return TRUE; - } - else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base)) - { - /* avoid dangling else. */ - (*c) = ((*c)*base)+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10); - return TRUE; - } - else - { - /* avoid dangling else. */ - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsDecimalDigitValidLong - returns the TRUE if, ch, is a base legal decimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsDecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c) -{ - if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base)) - { - (*c) = (*c)*((long unsigned int ) (base+( ((unsigned int) (ch))- ((unsigned int) ('0'))))); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsHexidecimalDigitValidLong - returns the TRUE if, ch, is a base legal hexidecimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsHexidecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c) -{ - if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base)) - { - (*c) = (*c)*((long unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10))); - return TRUE; - } - else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base)) - { - /* avoid dangling else. */ - (*c) = (*c)*((long unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10))); - return TRUE; - } - else - { - /* avoid dangling else. */ - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsDecimalDigitValidShort - returns the TRUE if, ch, is a base legal decimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsDecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c) -{ - if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base)) - { - (*c) = (*c)*((short unsigned int ) (base+( ((unsigned int) (ch))- ((unsigned int) ('0'))))); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsHexidecimalDigitValidShort - returns the TRUE if, ch, is a base legal hexidecimal digit. - If legal then the value is appended numerically onto, c. -*/ - -static unsigned int IsHexidecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c) -{ - if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base)) - { - (*c) = (*c)*((short unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10))); - return TRUE; - } - else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base)) - { - /* avoid dangling else. */ - (*c) = (*c)*((short unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10))); - return TRUE; - } - else - { - /* avoid dangling else. */ - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ToThePower10 - returns a LONGREAL containing the value of v * 10^power. -*/ - -static long double ToThePower10 (long double v, int power) -{ - int i; - - i = 0; - if (power > 0) - { - while (i < power) - { - v = v*10.0; - i += 1; - } - } - else - { - while (i > power) - { - v = v/10.0; - i -= 1; - } - } - return v; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DetermineSafeTruncation - we wish to use TRUNC when converting REAL/LONGREAL - into a string for the non fractional component. - However we need a simple method to - determine the maximum safe truncation value. -*/ - -static unsigned int DetermineSafeTruncation (void) -{ - double MaxPowerOfTen; - unsigned int LogPower; - - MaxPowerOfTen = static_cast (1.0); - LogPower = 0; - while ((MaxPowerOfTen*10.0) < ((double) ((INT_MAX) / 10))) - { - MaxPowerOfTen = MaxPowerOfTen*10.0; - LogPower += 1; - } - return LogPower; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - rtos - -*/ - -static DynamicStrings_String rtos (double r, unsigned int TotalWidth, unsigned int FractionWidth) -{ - M2RTS_HALT (-1); - __builtin_unreachable (); - return static_cast (NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - lrtos - -*/ - -static DynamicStrings_String lrtos (long double r, unsigned int TotalWidth, unsigned int FractionWidth) -{ - M2RTS_HALT (-1); - __builtin_unreachable (); - return static_cast (NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doDecimalPlaces - returns a string which is accurate to - n decimal places. It returns a new String - and, s, will be destroyed. -*/ - -static DynamicStrings_String doDecimalPlaces (DynamicStrings_String s, unsigned int n) -{ - int i; - int l; - int point; - DynamicStrings_String t; - DynamicStrings_String whole; - DynamicStrings_String fraction; - DynamicStrings_String tenths; - DynamicStrings_String hundreths; - - l = DynamicStrings_Length (s); - i = 0; - /* remove '.' */ - point = DynamicStrings_Index (s, '.', 0); - if (point == 0) - { - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0); - } - else if (point < l) - { - /* avoid dangling else. */ - s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point+1, 0))); - } - else - { - /* avoid dangling else. */ - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point); - } - l = DynamicStrings_Length (s); - i = 0; - if (l > 0) - { - /* skip over leading zeros */ - while ((i < l) && ((DynamicStrings_char (s, i)) == '0')) - { - i += 1; - } - /* was the string full of zeros? */ - if ((i == l) && ((DynamicStrings_char (s, i-1)) == '0')) - { - s = DynamicStrings_KillString (s); - s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0.", 2), DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), n))); - return s; - } - } - /* insert leading zero */ - s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('0'), DynamicStrings_Mark (s)); - point += 1; /* and move point position to correct place */ - l = DynamicStrings_Length (s); /* update new length */ - i = point; /* update new length */ - while ((n > 1) && (i < l)) - { - n -= 1; - i += 1; - } - if ((i+3) <= l) - { - t = DynamicStrings_Dup (s); - hundreths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+3); - s = t; - if ((StringConvert_stoc (hundreths)) >= 50) - { - s = carryOne (DynamicStrings_Mark (s), static_cast (i)); - } - hundreths = DynamicStrings_KillString (hundreths); - } - else if ((i+2) <= l) - { - /* avoid dangling else. */ - t = DynamicStrings_Dup (s); - tenths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+2); - s = t; - if ((StringConvert_stoc (tenths)) >= 5) - { - s = carryOne (DynamicStrings_Mark (s), static_cast (i)); - } - tenths = DynamicStrings_KillString (tenths); - } - /* check whether we need to remove the leading zero */ - if ((DynamicStrings_char (s, 0)) == '0') - { - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0); - l -= 1; - point -= 1; - } - if (i < l) - { - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i); - l = DynamicStrings_Length (s); - if (l < point) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast (point-l))); - } - } - /* re-insert the point */ - if (point >= 0) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (point == 0) - { - s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('.'), DynamicStrings_Mark (s)); - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), '.'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0))); - } - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doSigFig - returns a string which is accurate to - n decimal places. It returns a new String - and, s, will be destroyed. -*/ - -static DynamicStrings_String doSigFig (DynamicStrings_String s, unsigned int n) -{ - int i; - int l; - int z; - int point; - DynamicStrings_String t; - DynamicStrings_String tenths; - DynamicStrings_String hundreths; - - l = DynamicStrings_Length (s); - i = 0; - /* remove '.' */ - point = DynamicStrings_Index (s, '.', 0); - if (point >= 0) - { - if (point == 0) - { - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0); - } - else if (point < l) - { - /* avoid dangling else. */ - s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point+1, 0))); - } - else - { - /* avoid dangling else. */ - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point); - } - } - else - { - s = DynamicStrings_Dup (DynamicStrings_Mark (s)); - } - l = DynamicStrings_Length (s); - i = 0; - if (l > 0) - { - /* skip over leading zeros */ - while ((i < l) && ((DynamicStrings_char (s, i)) == '0')) - { - i += 1; - } - /* was the string full of zeros? */ - if ((i == l) && ((DynamicStrings_char (s, i-1)) == '0')) - { - /* truncate string */ - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast (n)); - i = n; - } - } - /* add a leading zero in case we need to overflow the carry */ - z = i; /* remember where we inserted zero */ - if (z == 0) /* remember where we inserted zero */ - { - s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('0'), DynamicStrings_Mark (s)); - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i), '0'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), i, 0))); - } - n += 1; /* and increase the number of sig figs needed */ - l = DynamicStrings_Length (s); /* and increase the number of sig figs needed */ - while ((n > 1) && (i < l)) - { - n -= 1; - i += 1; - } - if ((i+3) <= l) - { - t = DynamicStrings_Dup (s); - hundreths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+3); - s = t; - if ((StringConvert_stoc (hundreths)) >= 50) - { - s = carryOne (DynamicStrings_Mark (s), static_cast (i)); - } - hundreths = DynamicStrings_KillString (hundreths); - } - else if ((i+2) <= l) - { - /* avoid dangling else. */ - t = DynamicStrings_Dup (s); - tenths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+2); - s = t; - if ((StringConvert_stoc (tenths)) >= 5) - { - s = carryOne (DynamicStrings_Mark (s), static_cast (i)); - } - tenths = DynamicStrings_KillString (tenths); - } - /* check whether we need to remove the leading zero */ - if ((DynamicStrings_char (s, z)) == '0') - { - if (z == 0) - { - s = DynamicStrings_Slice (DynamicStrings_Mark (s), z+1, 0); - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, z), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), z+1, 0))); - } - l = DynamicStrings_Length (s); - } - else - { - point += 1; - } - if (i < l) - { - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i); - l = DynamicStrings_Length (s); - if (l < point) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast (point-l))); - } - } - /* re-insert the point */ - if (point >= 0) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (point == 0) - { - s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('.'), DynamicStrings_Mark (s)); - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), '.'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0))); - } - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - carryOne - add a carry at position, i. -*/ - -static DynamicStrings_String carryOne (DynamicStrings_String s, unsigned int i) -{ - if (i >= 0) - { - if (IsDigit (DynamicStrings_char (s, static_cast (i)))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((DynamicStrings_char (s, static_cast (i))) == '9') - { - if (i == 0) - { - s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('1'), DynamicStrings_Mark (s)); - return s; - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast (i)), '0'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast (i+1), 0))); - return carryOne (s, i-1); - } - } - else - { - if (i == 0) - { - s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ( ((char) ( ((unsigned int) (DynamicStrings_char (s, static_cast (i))))+1))), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast (i+1), 0))); - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast (i)), ((char) ( ((unsigned int) (DynamicStrings_char (s, static_cast (i))))+1))), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast (i+1), 0))); - } - } - } - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IntegerToString - converts INTEGER, i, into a String. The field with can be specified - if non zero. Leading characters are defined by padding and this - function will prepend a + if sign is set to TRUE. - The base allows the caller to generate binary, octal, decimal, hexidecimal - numbers. The value of lower is only used when hexidecimal numbers are - generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF - are used. -*/ - -extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower) -{ - DynamicStrings_String s; - unsigned int c; - - if (i < 0) - { - if (i == (INT_MIN)) - { - /* remember that -15 MOD 4 = 1 in Modula-2 */ - c = ((unsigned int ) (abs (i+1)))+1; - if (width > 0) - { - return DynamicStrings_ConCat (StringConvert_IntegerToString (-((int ) (c / base)), width-1, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast (c % base), 0, ' ', FALSE, base, lower))); - } - else - { - return DynamicStrings_ConCat (StringConvert_IntegerToString (-((int ) (c / base)), 0, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast (c % base), 0, ' ', FALSE, base, lower))); - } - } - else - { - s = DynamicStrings_InitString ((const char *) "-", 1); - } - i = -i; - } - else - { - if (sign) - { - s = DynamicStrings_InitString ((const char *) "+", 1); - } - else - { - s = DynamicStrings_InitString ((const char *) "", 0); - } - } - if (i > (((int ) (base))-1)) - { - s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_IntegerToString (static_cast (((unsigned int ) (i)) / base), 0, ' ', FALSE, base, lower))), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast (((unsigned int ) (i)) % base), 0, ' ', FALSE, base, lower))); - } - else - { - if (i <= 9) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (i))+ ((unsigned int) ('0'))))))); - } - else - { - if (lower) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('a')))-10))))); - } - else - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('A')))-10))))); - } - } - } - if (width > (DynamicStrings_Length (s))) - { - return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), DynamicStrings_Mark (s)); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CardinalToString - converts CARDINAL, c, into a String. The field with can be specified - if non zero. Leading characters are defined by padding. - The base allows the caller to generate binary, octal, decimal, hexidecimal - numbers. The value of lower is only used when hexidecimal numbers are - generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF - are used. -*/ - -extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitString ((const char *) "", 0); - if (c > (base-1)) - { - s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_CardinalToString (c / base, 0, ' ', base, lower))), DynamicStrings_Mark (StringConvert_CardinalToString (c % base, 0, ' ', base, lower))); - } - else - { - if (c <= 9) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (c+ ((unsigned int) ('0'))))))); - } - else - { - if (lower) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((c+ ((unsigned int) ('a')))-10))))); - } - else - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((c+ ((unsigned int) ('A')))-10))))); - } - } - } - if (width > (DynamicStrings_Length (s))) - { - return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StringToInteger - converts a string, s, of, base, into an INTEGER. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found) -{ - unsigned int n; - unsigned int l; - unsigned int c; - unsigned int negative; - - s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */ - l = DynamicStrings_Length (s); /* returns a new string, s */ - c = 0; - n = 0; - negative = FALSE; - if (n < l) - { - /* parse leading + and - */ - while (((DynamicStrings_char (s, static_cast (n))) == '-') || ((DynamicStrings_char (s, static_cast (n))) == '+')) - { - if ((DynamicStrings_char (s, static_cast (n))) == '-') - { - negative = ! negative; - } - n += 1; - } - while ((n < l) && ((IsDecimalDigitValid (DynamicStrings_char (s, static_cast (n)), base, &c)) || (IsHexidecimalDigitValid (DynamicStrings_char (s, static_cast (n)), base, &c)))) - { - (*found) = TRUE; - n += 1; - } - } - s = DynamicStrings_KillString (s); - if (negative) - { - return -((int ) (Min (((unsigned int ) (INT_MAX))+1, c))); - } - else - { - return (int ) (Min (static_cast (INT_MAX), c)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StringToCardinal - converts a string, s, of, base, into a CARDINAL. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found) -{ - unsigned int n; - unsigned int l; - unsigned int c; - - s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */ - l = DynamicStrings_Length (s); /* returns a new string, s */ - c = 0; - n = 0; - if (n < l) - { - /* parse leading + */ - while ((DynamicStrings_char (s, static_cast (n))) == '+') - { - n += 1; - } - while ((n < l) && ((IsDecimalDigitValid (DynamicStrings_char (s, static_cast (n)), base, &c)) || (IsHexidecimalDigitValid (DynamicStrings_char (s, static_cast (n)), base, &c)))) - { - (*found) = TRUE; - n += 1; - } - } - s = DynamicStrings_KillString (s); - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - LongIntegerToString - converts LONGINT, i, into a String. The field with - can be specified if non zero. Leading characters - are defined by padding and this function will - prepend a + if sign is set to TRUE. - The base allows the caller to generate binary, - octal, decimal, hexidecimal numbers. - The value of lower is only used when hexidecimal - numbers are generated and if TRUE then digits - abcdef are used, and if FALSE then ABCDEF are used. -*/ - -extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower) -{ - DynamicStrings_String s; - long unsigned int c; - - if (i < 0) - { - if (i == (LONG_MIN)) - { - /* remember that -15 MOD 4 is 1 in Modula-2, and although ABS(MIN(LONGINT)+1) - is very likely MAX(LONGINT), it is safer not to assume this is the case */ - c = ((long unsigned int ) (labs (i+1)))+1; - if (width > 0) - { - return DynamicStrings_ConCat (StringConvert_LongIntegerToString (-((long int ) (c / ((long unsigned int ) (base)))), width-1, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_LongIntegerToString (static_cast (c % ((long unsigned int ) (base))), 0, ' ', FALSE, base, lower))); - } - else - { - return DynamicStrings_ConCat (StringConvert_LongIntegerToString (-((long int ) (c / ((long unsigned int ) (base)))), 0, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_LongIntegerToString (static_cast (c % ((long unsigned int ) (base))), 0, ' ', FALSE, base, lower))); - } - } - else - { - s = DynamicStrings_InitString ((const char *) "-", 1); - } - i = -i; - } - else - { - if (sign) - { - s = DynamicStrings_InitString ((const char *) "+", 1); - } - else - { - s = DynamicStrings_InitString ((const char *) "", 0); - } - } - if (i > ((long int ) (base-1))) - { - s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_LongIntegerToString (i / ((long int ) (base)), 0, ' ', FALSE, base, lower))), DynamicStrings_Mark (StringConvert_LongIntegerToString (i % ((long int ) (base)), 0, ' ', FALSE, base, lower))); - } - else - { - if (i <= 9) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (i))+ ((unsigned int) ('0'))))))); - } - else - { - if (lower) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('a')))-10))))); - } - else - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('A')))-10))))); - } - } - } - if (width > (DynamicStrings_Length (s))) - { - return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StringToLongInteger - converts a string, s, of, base, into an LONGINT. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found) -{ - unsigned int n; - unsigned int l; - long unsigned int c; - unsigned int negative; - - s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */ - l = DynamicStrings_Length (s); /* returns a new string, s */ - c = 0; - n = 0; - negative = FALSE; - if (n < l) - { - /* parse leading + and - */ - while (((DynamicStrings_char (s, static_cast (n))) == '-') || ((DynamicStrings_char (s, static_cast (n))) == '+')) - { - if ((DynamicStrings_char (s, static_cast (n))) == '-') - { - negative = ! negative; - } - n += 1; - } - while ((n < l) && ((IsDecimalDigitValidLong (DynamicStrings_char (s, static_cast (n)), base, &c)) || (IsHexidecimalDigitValidLong (DynamicStrings_char (s, static_cast (n)), base, &c)))) - { - (*found) = TRUE; - n += 1; - } - } - s = DynamicStrings_KillString (s); - if (negative) - { - return -((long int ) (LongMin (((long unsigned int ) (LONG_MAX))+1, c))); - } - else - { - return (long int ) (LongMin (static_cast (LONG_MAX), c)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - LongCardinalToString - converts LONGCARD, c, into a String. The field - width can be specified if non zero. Leading - characters are defined by padding. - The base allows the caller to generate binary, - octal, decimal, hexidecimal numbers. - The value of lower is only used when hexidecimal - numbers are generated and if TRUE then digits - abcdef are used, and if FALSE then ABCDEF are used. -*/ - -extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitString ((const char *) "", 0); - if (c > ((long unsigned int ) (base-1))) - { - s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, StringConvert_LongCardinalToString (c / ((long unsigned int ) (base)), 0, ' ', base, lower)), StringConvert_LongCardinalToString (c % ((long unsigned int ) (base)), 0, ' ', base, lower)); - } - else - { - if (c <= 9) - { - s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (c))+ ((unsigned int) ('0')))))); - } - else - { - if (lower) - { - s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (c))+ ((unsigned int) ('a')))-10)))); - } - else - { - s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (c))+ ((unsigned int) ('A')))-10)))); - } - } - } - if (width > (DynamicStrings_Length (s))) - { - return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StringToLongCardinal - converts a string, s, of, base, into a LONGCARD. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found) -{ - unsigned int n; - unsigned int l; - long unsigned int c; - - s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */ - l = DynamicStrings_Length (s); /* returns a new string, s */ - c = 0; - n = 0; - if (n < l) - { - /* parse leading + */ - while ((DynamicStrings_char (s, static_cast (n))) == '+') - { - n += 1; - } - while ((n < l) && ((IsDecimalDigitValidLong (DynamicStrings_char (s, static_cast (n)), base, &c)) || (IsHexidecimalDigitValidLong (DynamicStrings_char (s, static_cast (n)), base, &c)))) - { - (*found) = TRUE; - n += 1; - } - } - s = DynamicStrings_KillString (s); - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ShortCardinalToString - converts SHORTCARD, c, into a String. The field - width can be specified if non zero. Leading - characters are defined by padding. - The base allows the caller to generate binary, - octal, decimal, hexidecimal numbers. - The value of lower is only used when hexidecimal - numbers are generated and if TRUE then digits - abcdef are used, and if FALSE then ABCDEF are used. -*/ - -extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitString ((const char *) "", 0); - if (((unsigned int ) (c)) > (base-1)) - { - s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, StringConvert_ShortCardinalToString (c / ((short unsigned int ) (base)), 0, ' ', base, lower)), StringConvert_ShortCardinalToString (c % ((short unsigned int ) (base)), 0, ' ', base, lower)); - } - else - { - if (c <= 9) - { - s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (c))+ ((unsigned int) ('0')))))); - } - else - { - if (lower) - { - s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (c))+ ((unsigned int) ('a')))-10)))); - } - else - { - s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (c))+ ((unsigned int) ('A')))-10)))); - } - } - } - if (width > (DynamicStrings_Length (s))) - { - return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StringToShortCardinal - converts a string, s, of, base, into a SHORTCARD. - Leading white space is ignored. It stops converting - when either the string is exhausted or if an illegal - numeral is found. - The parameter found is set TRUE if a number was found. -*/ - -extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found) -{ - unsigned int n; - unsigned int l; - short unsigned int c; - - s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */ - l = DynamicStrings_Length (s); /* returns a new string, s */ - c = 0; - n = 0; - if (n < l) - { - /* parse leading + */ - while ((DynamicStrings_char (s, static_cast (n))) == '+') - { - n += 1; - } - while ((n < l) && ((IsDecimalDigitValidShort (DynamicStrings_char (s, static_cast (n)), base, &c)) || (IsHexidecimalDigitValidShort (DynamicStrings_char (s, static_cast (n)), base, &c)))) - { - (*found) = TRUE; - n += 1; - } - } - s = DynamicStrings_KillString (s); - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - stoi - decimal string to INTEGER -*/ - -extern "C" int StringConvert_stoi (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToInteger (s, 10, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - itos - integer to decimal string. -*/ - -extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign) -{ - return StringConvert_IntegerToString (i, width, padding, sign, 10, FALSE); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ctos - cardinal to decimal string. -*/ - -extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding) -{ - return StringConvert_CardinalToString (c, width, padding, 10, FALSE); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - stoc - decimal string to CARDINAL -*/ - -extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToCardinal (s, 10, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - hstoi - hexidecimal string to INTEGER -*/ - -extern "C" int StringConvert_hstoi (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToInteger (s, 16, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ostoi - octal string to INTEGER -*/ - -extern "C" int StringConvert_ostoi (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToInteger (s, 8, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - bstoi - binary string to INTEGER -*/ - -extern "C" int StringConvert_bstoi (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToInteger (s, 2, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - hstoc - hexidecimal string to CARDINAL -*/ - -extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToCardinal (s, 16, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ostoc - octal string to CARDINAL -*/ - -extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToCardinal (s, 8, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - bstoc - binary string to CARDINAL -*/ - -extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToCardinal (s, 2, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StringToLongreal - returns a LONGREAL and sets found to TRUE if a legal number is seen. -*/ - -extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found) -{ - unsigned int error; - long double value; - - s = DynamicStrings_RemoveWhitePrefix (s); /* new string is created */ - value = ldtoa_strtold (DynamicStrings_string (s), &error); /* new string is created */ - s = DynamicStrings_KillString (s); - (*found) = ! error; - return value; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - LongrealToString - converts a LONGREAL number, Real, which has, - TotalWidth, and FractionWidth into a string. - It uses decimal notation. - - So for example: - - LongrealToString(1.0, 4, 2) -> '1.00' - LongrealToString(12.3, 5, 2) -> '12.30' - LongrealToString(12.3, 6, 2) -> ' 12.30' - LongrealToString(12.3, 6, 3) -> '12.300' - - if total width is too small then the fraction - becomes truncated. - - LongrealToString(12.3, 5, 3) -> '12.30' - - Positive numbers do not have a '+' prepended. - Negative numbers will have a '-' prepended and - the TotalWidth will need to be large enough - to contain the sign, whole number, '.' and - fractional components. -*/ - -extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth) -{ - unsigned int maxprecision; - DynamicStrings_String s; - void * r; - int point; - unsigned int sign; - int l; - - if (TotalWidth == 0) - { - maxprecision = TRUE; - r = ldtoa_ldtoa (x, ldtoa_decimaldigits, 100, &point, &sign); - } - else - { - r = ldtoa_ldtoa (x, ldtoa_decimaldigits, 100, &point, &sign); - } - s = DynamicStrings_InitStringCharStar (r); - libc_free (r); - l = DynamicStrings_Length (s); - if (point > l) - { - /* avoid dangling else. */ - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast (point-l)))); - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".0", 2))); - if (! maxprecision && (FractionWidth > 0)) - { - FractionWidth -= 1; - if (((int ) (FractionWidth)) > (point-l)) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "0", 1)), FractionWidth))); - } - } - } - else if (point < 0) - { - /* avoid dangling else. */ - s = DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast (-point)), DynamicStrings_Mark (s)); - l = DynamicStrings_Length (s); - s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0.", 2), DynamicStrings_Mark (s)); - if (! maxprecision && (l < ((int ) (FractionWidth)))) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "0", 1)), static_cast (((int ) (FractionWidth))-l)))); - } - } - else - { - /* avoid dangling else. */ - if (point == 0) - { - s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0.", 2), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0))); - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), '.'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0))); - } - if (! maxprecision && ((l-point) < ((int ) (FractionWidth)))) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "0", 1)), static_cast (((int ) (FractionWidth))-(l-point))))); - } - } - if ((DynamicStrings_Length (s)) > TotalWidth) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (TotalWidth > 0) - { - if (sign) - { - s = DynamicStrings_Slice (DynamicStrings_Mark (StringConvert_ToDecimalPlaces (s, FractionWidth)), 0, static_cast (TotalWidth-1)); - s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('-'), DynamicStrings_Mark (s)); - sign = FALSE; - } - else - { - /* minus 1 because all results will include a '.' */ - s = DynamicStrings_Slice (DynamicStrings_Mark (StringConvert_ToDecimalPlaces (s, FractionWidth)), 0, static_cast (TotalWidth)); - } - } - else - { - if (sign) - { - s = StringConvert_ToDecimalPlaces (s, FractionWidth); - s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('-'), DynamicStrings_Mark (s)); - sign = FALSE; - } - else - { - /* minus 1 because all results will include a '.' */ - s = StringConvert_ToDecimalPlaces (s, FractionWidth); - } - } - } - if ((DynamicStrings_Length (s)) < TotalWidth) - { - s = DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (' ')), TotalWidth-(DynamicStrings_Length (s))), DynamicStrings_Mark (s)); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - stor - returns a REAL given a string. -*/ - -extern "C" double StringConvert_stor (DynamicStrings_String s) -{ - unsigned int found; - - return (double ) (StringConvert_StringToLongreal (s, &found)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - stolr - returns a LONGREAL given a string. -*/ - -extern "C" long double StringConvert_stolr (DynamicStrings_String s) -{ - unsigned int found; - - return StringConvert_StringToLongreal (s, &found); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ToSigFig - returns a floating point or base 10 integer - string which is accurate to, n, significant - figures. It will return a new String - and, s, will be destroyed. - - - So: 12.345 - - rounded to the following significant figures yields - - 5 12.345 - 4 12.34 - 3 12.3 - 2 12 - 1 10 -*/ - -extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n) -{ - int point; - unsigned int poTen; - - Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/StringConvert.mod", 54, 1222, (const char *) "ToSigFig", 8); - point = DynamicStrings_Index (s, '.', 0); - if (point < 0) - { - poTen = DynamicStrings_Length (s); - } - else - { - poTen = point; - } - s = doSigFig (s, n); - /* if the last character is '.' remove it */ - if (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, -1)) == '.')) - { - return DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); - } - else - { - if (poTen > (DynamicStrings_Length (s))) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), poTen-(DynamicStrings_Length (s))))); - } - return s; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ToDecimalPlaces - returns a floating point or base 10 integer - string which is accurate to, n, decimal - places. It will return a new String - and, s, will be destroyed. - Decimal places yields, n, digits after - the . - - So: 12.345 - - rounded to the following decimal places yields - - 5 12.34500 - 4 12.3450 - 3 12.345 - 2 12.34 - 1 12.3 -*/ - -extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n) -{ - int point; - - Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/StringConvert.mod", 54, 1069, (const char *) "ToDecimalPlaces", 15); - point = DynamicStrings_Index (s, '.', 0); - if (point < 0) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (n > 0) - { - return DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ('.'))), DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), n)); - } - else - { - return s; - } - } - s = doDecimalPlaces (s, n); - /* if the last character is '.' remove it */ - if (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, -1)) == '.')) - { - return DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); - } - else - { - return s; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_StringConvert_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_StringConvert_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GSysStorage.c b/gcc/m2/mc-boot/GSysStorage.c deleted file mode 100644 index 98c03f66c358..000000000000 --- a/gcc/m2/mc-boot/GSysStorage.c +++ /dev/null @@ -1,249 +0,0 @@ -/* do not edit automatically generated by mc from SysStorage. */ -/* SysStorage.mod provides dynamic allocation for the system components. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _SysStorage_H -#define _SysStorage_C - -# include "Glibc.h" -# include "GDebug.h" -# include "GSYSTEM.h" - -# define enableDeallocation TRUE -# define enableZero FALSE -# define enableTrace FALSE -static unsigned int callno; -static unsigned int zero; -static unsigned int trace; -extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size); -extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size); - -/* - REALLOCATE - attempts to reallocate storage. The address, - a, should either be NIL in which case ALLOCATE - is called, or alternatively it should have already - been initialized by ALLOCATE. The allocated storage - is resized accordingly. -*/ - -extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size); - -/* - REALLOCATE - attempts to reallocate storage. The address, - a, should either be NIL in which case ALLOCATE - is called, or alternatively it should have already - been initialized by ALLOCATE. The allocated storage - is resized accordingly. -*/ - -extern "C" unsigned int SysStorage_Available (unsigned int size); - -/* - Init - initializes the heap. This does nothing on a GNU/Linux system. - But it remains here since it might be used in an embedded system. -*/ - -extern "C" void SysStorage_Init (void); - -extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size) -{ - (*a) = libc_malloc (static_cast (size)); - if ((*a) == NULL) - { - Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51); - } - if (enableTrace && trace) - { - libc_printf ((const char *) " %d SysStorage.ALLOCATE (0x%x, %d bytes)\\n", 54, callno, (*a), size); - libc_printf ((const char *) " %ld %d\\n", 20, (*a), size); - callno += 1; - } -} - -extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size) -{ - if (enableTrace && trace) - { - libc_printf ((const char *) " %d SysStorage.DEALLOCATE (0x%x, %d bytes)\\n", 56, callno, (*a), size); - callno += 1; - } - if (enableZero && zero) - { - if (enableTrace && trace) - { - libc_printf ((const char *) " memset (0x%x, 0, %d bytes)\\n", 30, (*a), size); - } - if ((libc_memset ((*a), 0, static_cast (size))) != (*a)) - { - Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51); - } - } - if (enableDeallocation) - { - if (enableTrace && trace) - { - libc_printf ((const char *) " free (0x%x) %d bytes\\n", 26, (*a), size); - libc_printf ((const char *) " %ld %d\\n", 19, (*a), size); - } - libc_free ((*a)); - } - (*a) = NULL; -} - - -/* - REALLOCATE - attempts to reallocate storage. The address, - a, should either be NIL in which case ALLOCATE - is called, or alternatively it should have already - been initialized by ALLOCATE. The allocated storage - is resized accordingly. -*/ - -extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size) -{ - if ((*a) == NULL) - { - SysStorage_ALLOCATE (a, size); - } - else - { - if (enableTrace && trace) - { - libc_printf ((const char *) " %d SysStorage.REALLOCATE (0x%x, %d bytes)\\n", 56, callno, (*a), size); - callno += 1; - } - if (enableTrace && trace) - { - libc_printf ((const char *) " realloc (0x%x, %d bytes) -> ", 32, (*a), size); - libc_printf ((const char *) " %ld %d\\n", 19, (*a), size); - } - (*a) = libc_realloc ((*a), static_cast (size)); - if ((*a) == NULL) - { - Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51); - } - if (enableTrace && trace) - { - libc_printf ((const char *) " %ld %d\\n", 20, (*a), size); - libc_printf ((const char *) " 0x%x %d bytes\\n", 18, (*a), size); - } - } -} - - -/* - REALLOCATE - attempts to reallocate storage. The address, - a, should either be NIL in which case ALLOCATE - is called, or alternatively it should have already - been initialized by ALLOCATE. The allocated storage - is resized accordingly. -*/ - -extern "C" unsigned int SysStorage_Available (unsigned int size) -{ - void * a; - - if (enableTrace && trace) - { - libc_printf ((const char *) " %d SysStorage.Available (%d bytes)\\n", 49, callno, size); - callno += 1; - } - a = libc_malloc (static_cast (size)); - if (a == NULL) - { - if (enableTrace && trace) - { - libc_printf ((const char *) " no\\n", 7, size); - } - return FALSE; - } - else - { - if (enableTrace && trace) - { - libc_printf ((const char *) " yes\\n", 8, size); - } - libc_free (a); - return TRUE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Init - initializes the heap. This does nothing on a GNU/Linux system. - But it remains here since it might be used in an embedded system. -*/ - -extern "C" void SysStorage_Init (void) -{ -} - -extern "C" void _M2_SysStorage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - callno = 0; - if (enableTrace) - { - trace = (libc_getenv (const_cast (reinterpret_cast("M2DEBUG_SYSSTORAGE_trace")))) != NULL; - } - else - { - trace = FALSE; - } - if (enableZero) - { - zero = (libc_getenv (const_cast (reinterpret_cast("M2DEBUG_SYSSTORAGE_zero")))) != NULL; - } - else - { - zero = FALSE; - } -} - -extern "C" void _M2_SysStorage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GTimeString.c b/gcc/m2/mc-boot/GTimeString.c deleted file mode 100644 index 7e50f4b75518..000000000000 --- a/gcc/m2/mc-boot/GTimeString.c +++ /dev/null @@ -1,91 +0,0 @@ -/* do not edit automatically generated by mc from TimeString. */ -/* TimeString.mod provides time related string manipulation procedures. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _TimeString_H -#define _TimeString_C - -# include "Gwrapc.h" -# include "GASCII.h" -# include "GSYSTEM.h" - - -/* - GetTimeString - places the time in ascii format into array, a. - -*/ - -extern "C" void TimeString_GetTimeString (char *a, unsigned int _a_high); - - -/* - GetTimeString - places the time in ascii format into array, a. - -*/ - -extern "C" void TimeString_GetTimeString (char *a, unsigned int _a_high) -{ - typedef char *GetTimeString__T1; - - GetTimeString__T1 Addr; - unsigned int i; - - Addr = static_cast (wrapc_strtime ()); - i = 0; - if (Addr != NULL) - { - while ((i < _a_high) && ((*Addr) != ASCII_nul)) - { - a[i] = (*Addr); - i += 1; - Addr += 1; - } - } - if (i < _a_high) - { - a[i] = ASCII_nul; - } -} - -extern "C" void _M2_TimeString_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_TimeString_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Galists.c b/gcc/m2/mc-boot/Galists.c deleted file mode 100644 index 3e84a5003377..000000000000 --- a/gcc/m2/mc-boot/Galists.c +++ /dev/null @@ -1,440 +0,0 @@ -/* do not edit automatically generated by mc from alists. */ -/* alists.mod address lists module. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _alists_H -#define _alists_C - -# include "GStorage.h" - -typedef struct alists_performOperation_p alists_performOperation; - -# define MaxnoOfelements 5 -typedef struct alists__T1_r alists__T1; - -typedef struct alists__T2_a alists__T2; - -typedef alists__T1 *alists_alist; - -typedef void (*alists_performOperation_t) (void *); -struct alists_performOperation_p { alists_performOperation_t proc; }; - -struct alists__T2_a { void * array[MaxnoOfelements-1+1]; }; -struct alists__T1_r { - unsigned int noOfelements; - alists__T2 elements; - alists_alist next; - }; - - -/* - initList - creates a new alist, l. -*/ - -extern "C" alists_alist alists_initList (void); - -/* - killList - deletes the complete alist, l. -*/ - -extern "C" void alists_killList (alists_alist *l); - -/* - putItemIntoList - places an ADDRESS, c, into alist, l. -*/ - -extern "C" void alists_putItemIntoList (alists_alist l, void * c); - -/* - getItemFromList - retrieves the nth WORD from alist, l. -*/ - -extern "C" void * alists_getItemFromList (alists_alist l, unsigned int n); - -/* - getIndexOfList - returns the index for WORD, c, in alist, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int alists_getIndexOfList (alists_alist l, void * c); - -/* - noOfItemsInList - returns the number of items in alist, l. -*/ - -extern "C" unsigned int alists_noOfItemsInList (alists_alist l); - -/* - includeItemIntoList - adds an ADDRESS, c, into a alist providing - the value does not already exist. -*/ - -extern "C" void alists_includeItemIntoList (alists_alist l, void * c); - -/* - removeItemFromList - removes a ADDRESS, c, from a alist. - It assumes that this value only appears once. -*/ - -extern "C" void alists_removeItemFromList (alists_alist l, void * c); - -/* - isItemInList - returns true if a ADDRESS, c, was found in alist, l. -*/ - -extern "C" unsigned int alists_isItemInList (alists_alist l, void * c); - -/* - foreachItemInListDo - calls procedure, P, foreach item in alist, l. -*/ - -extern "C" void alists_foreachItemInListDo (alists_alist l, alists_performOperation p); - -/* - duplicateList - returns a duplicate alist derived from, l. -*/ - -extern "C" alists_alist alists_duplicateList (alists_alist l); - -/* - removeItem - remove an element at index, i, from the alist data type. -*/ - -static void removeItem (alists_alist p, alists_alist l, unsigned int i); - - -/* - removeItem - remove an element at index, i, from the alist data type. -*/ - -static void removeItem (alists_alist p, alists_alist l, unsigned int i) -{ - l->noOfelements -= 1; - while (i <= l->noOfelements) - { - l->elements.array[i-1] = l->elements.array[i+1-1]; - i += 1; - } - if ((l->noOfelements == 0) && (p != NULL)) - { - p->next = l->next; - Storage_DEALLOCATE ((void **) &l, sizeof (alists__T1)); - } -} - - -/* - initList - creates a new alist, l. -*/ - -extern "C" alists_alist alists_initList (void) -{ - alists_alist l; - - Storage_ALLOCATE ((void **) &l, sizeof (alists__T1)); - l->noOfelements = 0; - l->next = NULL; - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - killList - deletes the complete alist, l. -*/ - -extern "C" void alists_killList (alists_alist *l) -{ - if ((*l) != NULL) - { - if ((*l)->next != NULL) - { - alists_killList (&(*l)->next); - } - Storage_DEALLOCATE ((void **) &(*l), sizeof (alists__T1)); - } -} - - -/* - putItemIntoList - places an ADDRESS, c, into alist, l. -*/ - -extern "C" void alists_putItemIntoList (alists_alist l, void * c) -{ - if (l->noOfelements < MaxnoOfelements) - { - l->noOfelements += 1; - l->elements.array[l->noOfelements-1] = c; - } - else if (l->next != NULL) - { - /* avoid dangling else. */ - alists_putItemIntoList (l->next, c); - } - else - { - /* avoid dangling else. */ - l->next = alists_initList (); - alists_putItemIntoList (l->next, c); - } -} - - -/* - getItemFromList - retrieves the nth WORD from alist, l. -*/ - -extern "C" void * alists_getItemFromList (alists_alist l, unsigned int n) -{ - while (l != NULL) - { - if (n <= l->noOfelements) - { - return l->elements.array[n-1]; - } - else - { - n -= l->noOfelements; - } - l = l->next; - } - return reinterpret_cast (0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getIndexOfList - returns the index for WORD, c, in alist, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int alists_getIndexOfList (alists_alist l, void * c) -{ - unsigned int i; - - if (l == NULL) - { - return 0; - } - else - { - i = 1; - while (i <= l->noOfelements) - { - if (l->elements.array[i-1] == c) - { - return i; - } - else - { - i += 1; - } - } - return l->noOfelements+(alists_getIndexOfList (l->next, c)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - noOfItemsInList - returns the number of items in alist, l. -*/ - -extern "C" unsigned int alists_noOfItemsInList (alists_alist l) -{ - unsigned int t; - - if (l == NULL) - { - return 0; - } - else - { - t = 0; - do { - t += l->noOfelements; - l = l->next; - } while (! (l == NULL)); - return t; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - includeItemIntoList - adds an ADDRESS, c, into a alist providing - the value does not already exist. -*/ - -extern "C" void alists_includeItemIntoList (alists_alist l, void * c) -{ - if (! (alists_isItemInList (l, c))) - { - alists_putItemIntoList (l, c); - } -} - - -/* - removeItemFromList - removes a ADDRESS, c, from a alist. - It assumes that this value only appears once. -*/ - -extern "C" void alists_removeItemFromList (alists_alist l, void * c) -{ - alists_alist p; - unsigned int i; - unsigned int found; - - if (l != NULL) - { - found = FALSE; - p = NULL; - do { - i = 1; - while ((i <= l->noOfelements) && (l->elements.array[i-1] != c)) - { - i += 1; - } - if ((i <= l->noOfelements) && (l->elements.array[i-1] == c)) - { - found = TRUE; - } - else - { - p = l; - l = l->next; - } - } while (! ((l == NULL) || found)); - if (found) - { - removeItem (p, l, i); - } - } -} - - -/* - isItemInList - returns true if a ADDRESS, c, was found in alist, l. -*/ - -extern "C" unsigned int alists_isItemInList (alists_alist l, void * c) -{ - unsigned int i; - - do { - i = 1; - while (i <= l->noOfelements) - { - if (l->elements.array[i-1] == c) - { - return TRUE; - } - else - { - i += 1; - } - } - l = l->next; - } while (! (l == NULL)); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - foreachItemInListDo - calls procedure, P, foreach item in alist, l. -*/ - -extern "C" void alists_foreachItemInListDo (alists_alist l, alists_performOperation p) -{ - unsigned int i; - unsigned int n; - - n = alists_noOfItemsInList (l); - i = 1; - while (i <= n) - { - (*p.proc) (alists_getItemFromList (l, i)); - i += 1; - } -} - - -/* - duplicateList - returns a duplicate alist derived from, l. -*/ - -extern "C" alists_alist alists_duplicateList (alists_alist l) -{ - alists_alist m; - unsigned int n; - unsigned int i; - - m = alists_initList (); - n = alists_noOfItemsInList (l); - i = 1; - while (i <= n) - { - alists_putItemIntoList (m, alists_getItemFromList (l, i)); - i += 1; - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_alists_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_alists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gdecl.c b/gcc/m2/mc-boot/Gdecl.c deleted file mode 100644 index 4a851638d391..000000000000 --- a/gcc/m2/mc-boot/Gdecl.c +++ /dev/null @@ -1,26926 +0,0 @@ -/* do not edit automatically generated by mc from decl. */ -/* decl.mod declaration nodes used to create the AST. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -typedef unsigned int nameKey_Name; - -# define nameKey_NulName 0 -typedef struct mcPretty_writeProc_p mcPretty_writeProc; - -typedef struct symbolKey__T8_r symbolKey__T8; - -typedef symbolKey__T8 *symbolKey_symbolTree; - -typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc; - -typedef unsigned int FIO_File; - -extern FIO_File FIO_StdOut; -# define symbolKey_NulKey NULL -typedef struct symbolKey_performOperation_p symbolKey_performOperation; - -# define ASCII_tab ASCII_ht -typedef struct alists__T13_r alists__T13; - -typedef alists__T13 *alists_alist; - -typedef struct alists__T14_a alists__T14; - -# define ASCII_ht (char) 011 -# define ASCII_lf ASCII_nl -# define ASCII_nl (char) 012 -typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure; - -typedef struct decl_isNodeF_p decl_isNodeF; - -# define SYSTEM_BITSPERBYTE 8 -# define SYSTEM_BYTESPERWORD 4 -typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP; - -typedef struct symbolKey_isSymbol_p symbolKey_isSymbol; - -# define ASCII_nul (char) 000 -# define ASCII_soh (char) 001 -# define ASCII_stx (char) 002 -# define ASCII_etx (char) 003 -# define ASCII_eot (char) 004 -# define ASCII_enq (char) 005 -# define ASCII_ack (char) 006 -# define ASCII_bel (char) 007 -# define ASCII_bs (char) 010 -# define ASCII_vt (char) 013 -# define ASCII_np (char) 014 -# define ASCII_cr (char) 015 -# define ASCII_so (char) 016 -# define ASCII_si (char) 017 -# define ASCII_dle (char) 020 -# define ASCII_dc1 (char) 021 -# define ASCII_dc2 (char) 022 -# define ASCII_dc3 (char) 023 -# define ASCII_dc4 (char) 024 -# define ASCII_nak (char) 025 -# define ASCII_syn (char) 026 -# define ASCII_etb (char) 027 -# define ASCII_can (char) 030 -# define ASCII_em (char) 031 -# define ASCII_sub (char) 032 -# define ASCII_esc (char) 033 -# define ASCII_fs (char) 034 -# define ASCII_gs (char) 035 -# define ASCII_rs (char) 036 -# define ASCII_us (char) 037 -# define ASCII_sp (char) 040 -# define ASCII_ff ASCII_np -# define ASCII_eof ASCII_eot -# define ASCII_del (char) 0177 -# define ASCII_EOL ASCII_nl -extern FIO_File FIO_StdErr; -extern FIO_File FIO_StdIn; -typedef long int libc_time_t; - -typedef struct libc_tm_r libc_tm; - -typedef libc_tm *libc_ptrToTM; - -typedef struct libc_timeb_r libc_timeb; - -typedef struct libc_exitP_p libc_exitP; - -typedef struct mcError__T11_r mcError__T11; - -typedef mcError__T11 *mcError_error; - -extern int mcLexBuf_currentinteger; -extern unsigned int mcLexBuf_currentcolumn; -extern void * mcLexBuf_currentstring; -typedef struct alists_performOperation_p alists_performOperation; - -typedef struct wlists_performOperation_p wlists_performOperation; - -typedef struct StdIO_ProcWrite_p StdIO_ProcWrite; - -typedef struct StdIO_ProcRead_p StdIO_ProcRead; - -# define indentation 3 -# define indentationC 2 -# define debugScopes FALSE -# define debugDecl FALSE -# define caseException TRUE -# define returnException TRUE -# define forceCompoundStatement TRUE -# define enableDefForCStrings FALSE -# define enableMemsetOnAllocation TRUE -# define forceQualified TRUE -typedef struct decl_nodeRec_r decl_nodeRec; - -typedef struct decl_intrinsicT_r decl_intrinsicT; - -typedef struct decl_fixupInfo_r decl_fixupInfo; - -typedef struct decl_explistT_r decl_explistT; - -typedef struct decl_setvalueT_r decl_setvalueT; - -typedef struct decl_identlistT_r decl_identlistT; - -typedef struct decl_funccallT_r decl_funccallT; - -typedef struct decl_commentT_r decl_commentT; - -typedef struct decl_stmtT_r decl_stmtT; - -typedef struct decl_returnT_r decl_returnT; - -typedef struct decl_exitT_r decl_exitT; - -typedef struct decl_vardeclT_r decl_vardeclT; - -typedef struct decl_typeT_r decl_typeT; - -typedef struct decl_recordT_r decl_recordT; - -typedef struct decl_varientT_r decl_varientT; - -typedef struct decl_varT_r decl_varT; - -typedef struct decl_enumerationT_r decl_enumerationT; - -typedef struct decl_subrangeT_r decl_subrangeT; - -typedef struct decl_subscriptT_r decl_subscriptT; - -typedef struct decl_arrayT_r decl_arrayT; - -typedef struct decl_stringT_r decl_stringT; - -typedef struct decl_literalT_r decl_literalT; - -typedef struct decl_constT_r decl_constT; - -typedef struct decl_varparamT_r decl_varparamT; - -typedef struct decl_paramT_r decl_paramT; - -typedef struct decl_varargsT_r decl_varargsT; - -typedef struct decl_optargT_r decl_optargT; - -typedef struct decl_pointerT_r decl_pointerT; - -typedef struct decl_recordfieldT_r decl_recordfieldT; - -typedef struct decl_varientfieldT_r decl_varientfieldT; - -typedef struct decl_enumerationfieldT_r decl_enumerationfieldT; - -typedef struct decl_setT_r decl_setT; - -typedef struct decl_componentrefT_r decl_componentrefT; - -typedef struct decl_pointerrefT_r decl_pointerrefT; - -typedef struct decl_arrayrefT_r decl_arrayrefT; - -typedef struct decl_commentPair_r decl_commentPair; - -typedef struct decl_assignmentT_r decl_assignmentT; - -typedef struct decl_ifT_r decl_ifT; - -typedef struct decl_elsifT_r decl_elsifT; - -typedef struct decl_loopT_r decl_loopT; - -typedef struct decl_whileT_r decl_whileT; - -typedef struct decl_repeatT_r decl_repeatT; - -typedef struct decl_caseT_r decl_caseT; - -typedef struct decl_caselabellistT_r decl_caselabellistT; - -typedef struct decl_caselistT_r decl_caselistT; - -typedef struct decl_rangeT_r decl_rangeT; - -typedef struct decl_forT_r decl_forT; - -typedef struct decl_statementT_r decl_statementT; - -typedef struct decl_scopeT_r decl_scopeT; - -typedef struct decl_procedureT_r decl_procedureT; - -typedef struct decl_proctypeT_r decl_proctypeT; - -typedef struct decl_binaryT_r decl_binaryT; - -typedef struct decl_unaryT_r decl_unaryT; - -typedef struct decl_moduleT_r decl_moduleT; - -typedef struct decl_defT_r decl_defT; - -typedef struct decl_impT_r decl_impT; - -typedef struct decl_where_r decl_where; - -typedef struct decl_nodeProcedure_p decl_nodeProcedure; - -typedef struct decl_cnameT_r decl_cnameT; - -# define MaxBuf 127 -# define maxNoOfElements 5 -typedef enum {decl_explist, decl_funccall, decl_exit, decl_return, decl_stmtseq, decl_comment, decl_halt, decl_new, decl_dispose, decl_inc, decl_dec, decl_incl, decl_excl, decl_length, decl_nil, decl_true, decl_false, decl_address, decl_loc, decl_byte, decl_word, decl_csizet, decl_cssizet, decl_char, decl_cardinal, decl_longcard, decl_shortcard, decl_integer, decl_longint, decl_shortint, decl_real, decl_longreal, decl_shortreal, decl_bitset, decl_boolean, decl_proc, decl_ztype, decl_rtype, decl_complex, decl_longcomplex, decl_shortcomplex, decl_type, decl_record, decl_varient, decl_var, decl_enumeration, decl_subrange, decl_array, decl_subscript, decl_string, decl_const, decl_literal, decl_varparam, decl_param, decl_varargs, decl_optarg, decl_pointer, decl_recordfield, decl_varientfield, decl_enumerationfield, decl_set, decl_proctype, decl_procedure, decl_def, decl_imp, decl_module, decl_loop, decl_while, decl_for, decl_repeat, decl_case, decl_caselabellist, decl_caselist, decl_range, decl_assignment, decl_if, decl_elsif, decl_constexp, decl_neg, decl_cast, decl_val, decl_plus, decl_sub, decl_div, decl_mod, decl_mult, decl_divide, decl_in, decl_adr, decl_size, decl_tsize, decl_ord, decl_float, decl_trunc, decl_chr, decl_abs, decl_cap, decl_high, decl_throw, decl_unreachable, decl_cmplx, decl_re, decl_im, decl_min, decl_max, decl_componentref, decl_pointerref, decl_arrayref, decl_deref, decl_equal, decl_notequal, decl_less, decl_greater, decl_greequal, decl_lessequal, decl_lsl, decl_lsr, decl_lor, decl_land, decl_lnot, decl_lxor, decl_and, decl_or, decl_not, decl_identlist, decl_vardecl, decl_setvalue} decl_nodeT; - -# define MaxnoOfelements 5 -typedef enum {mcReserved_eoftok, mcReserved_plustok, mcReserved_minustok, mcReserved_timestok, mcReserved_dividetok, mcReserved_becomestok, mcReserved_ambersandtok, mcReserved_periodtok, mcReserved_commatok, mcReserved_semicolontok, mcReserved_lparatok, mcReserved_rparatok, mcReserved_lsbratok, mcReserved_rsbratok, mcReserved_lcbratok, mcReserved_rcbratok, mcReserved_uparrowtok, mcReserved_singlequotetok, mcReserved_equaltok, mcReserved_hashtok, mcReserved_lesstok, mcReserved_greatertok, mcReserved_lessgreatertok, mcReserved_lessequaltok, mcReserved_greaterequaltok, mcReserved_ldirectivetok, mcReserved_rdirectivetok, mcReserved_periodperiodtok, mcReserved_colontok, mcReserved_doublequotestok, mcReserved_bartok, mcReserved_andtok, mcReserved_arraytok, mcReserved_begintok, mcReserved_bytok, mcReserved_casetok, mcReserved_consttok, mcReserved_definitiontok, mcReserved_divtok, mcReserved_dotok, mcReserved_elsetok, mcReserved_elsiftok, mcReserved_endtok, mcReserved_excepttok, mcReserved_exittok, mcReserved_exporttok, mcReserved_finallytok, mcReserved_fortok, mcReserved_fromtok, mcReserved_iftok, mcReserved_implementationtok, mcReserved_importtok, mcReserved_intok, mcReserved_looptok, mcReserved_modtok, mcReserved_moduletok, mcReserved_nottok, mcReserved_oftok, mcReserved_ortok, mcReserved_packedsettok, mcReserved_pointertok, mcReserved_proceduretok, mcReserved_qualifiedtok, mcReserved_unqualifiedtok, mcReserved_recordtok, mcReserved_remtok, mcReserved_repeattok, mcReserved_retrytok, mcReserved_returntok, mcReserved_settok, mcReserved_thentok, mcReserved_totok, mcReserved_typetok, mcReserved_untiltok, mcReserved_vartok, mcReserved_whiletok, mcReserved_withtok, mcReserved_asmtok, mcReserved_volatiletok, mcReserved_periodperiodperiodtok, mcReserved_datetok, mcReserved_linetok, mcReserved_filetok, mcReserved_attributetok, mcReserved_builtintok, mcReserved_inlinetok, mcReserved_integertok, mcReserved_identtok, mcReserved_realtok, mcReserved_stringtok, mcReserved_commenttok} mcReserved_toktype; - -extern mcReserved_toktype mcLexBuf_currenttoken; -typedef enum {decl_ansiC, decl_ansiCP, decl_pim4} decl_language; - -typedef enum {decl_completed, decl_blocked, decl_partial, decl_recursive} decl_dependentState; - -typedef enum {decl_text, decl_punct, decl_space} decl_outputStates; - -typedef decl_nodeRec *decl_node; - -typedef struct Indexing__T5_r Indexing__T5; - -typedef struct mcComment__T6_r mcComment__T6; - -typedef enum {mcComment_unknown, mcComment_procedureHeading, mcComment_inBody, mcComment_afterStatement} mcComment_commentType; - -typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord; - -typedef struct DynamicStrings_Contents_r DynamicStrings_Contents; - -typedef struct wlists__T9_r wlists__T9; - -typedef struct mcPretty__T12_r mcPretty__T12; - -typedef struct wlists__T10_a wlists__T10; - -typedef struct DynamicStrings__T7_a DynamicStrings__T7; - -typedef Indexing__T5 *Indexing_Index; - -typedef mcComment__T6 *mcComment_commentDesc; - -extern mcComment_commentDesc mcLexBuf_currentcomment; -extern mcComment_commentDesc mcLexBuf_lastcomment; -typedef DynamicStrings_stringRecord *DynamicStrings_String; - -typedef wlists__T9 *wlists_wlist; - -typedef mcPretty__T12 *mcPretty_pretty; - -typedef void (*mcPretty_writeProc_t) (char); -struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; }; - -struct symbolKey__T8_r { - nameKey_Name name; - void *key; - symbolKey_symbolTree left; - symbolKey_symbolTree right; - }; - -typedef void (*mcPretty_writeLnProc_t) (void); -struct mcPretty_writeLnProc_p { mcPretty_writeLnProc_t proc; }; - -typedef void (*symbolKey_performOperation_t) (void *); -struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; }; - -struct alists__T14_a { void * array[MaxnoOfelements-1+1]; }; -typedef void (*Indexing_IndexProcedure_t) (void *); -struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; }; - -typedef unsigned int (*decl_isNodeF_t) (decl_node); -struct decl_isNodeF_p { decl_isNodeF_t proc; }; - -typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *); -struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; }; - -typedef unsigned int (*symbolKey_isSymbol_t) (void *); -struct symbolKey_isSymbol_p { symbolKey_isSymbol_t proc; }; - -struct libc_tm_r { - int tm_sec; - int tm_min; - int tm_hour; - int tm_mday; - int tm_mon; - int tm_year; - int tm_wday; - int tm_yday; - int tm_isdst; - long int tm_gmtoff; - void *tm_zone; - }; - -struct libc_timeb_r { - libc_time_t time_; - short unsigned int millitm; - short unsigned int timezone; - short unsigned int dstflag; - }; - -typedef int (*libc_exitP_t) (void); -typedef libc_exitP_t libc_exitP_C; - -struct libc_exitP_p { libc_exitP_t proc; }; - -struct mcError__T11_r { - mcError_error parent; - mcError_error child; - mcError_error next; - unsigned int fatal; - DynamicStrings_String s; - unsigned int token; - }; - -typedef void (*alists_performOperation_t) (void *); -struct alists_performOperation_p { alists_performOperation_t proc; }; - -typedef void (*wlists_performOperation_t) (unsigned int); -struct wlists_performOperation_p { wlists_performOperation_t proc; }; - -typedef void (*StdIO_ProcWrite_t) (char); -struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; }; - -typedef void (*StdIO_ProcRead_t) (char *); -struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; }; - -struct decl_fixupInfo_r { - unsigned int count; - Indexing_Index info; - }; - -struct decl_explistT_r { - Indexing_Index exp; - }; - -struct decl_setvalueT_r { - decl_node type; - Indexing_Index values; - }; - -struct decl_identlistT_r { - wlists_wlist names; - unsigned int cnamed; - }; - -struct decl_commentT_r { - mcComment_commentDesc content; - }; - -struct decl_stmtT_r { - Indexing_Index statements; - }; - -struct decl_exitT_r { - decl_node loop; - }; - -struct decl_vardeclT_r { - wlists_wlist names; - decl_node type; - decl_node scope; - }; - -struct decl_typeT_r { - nameKey_Name name; - decl_node type; - decl_node scope; - unsigned int isHidden; - unsigned int isInternal; - }; - -struct decl_recordT_r { - symbolKey_symbolTree localSymbols; - Indexing_Index listOfSons; - decl_node scope; - }; - -struct decl_varientT_r { - Indexing_Index listOfSons; - decl_node varient; - decl_node tag; - decl_node scope; - }; - -struct decl_enumerationT_r { - unsigned int noOfElements; - symbolKey_symbolTree localSymbols; - Indexing_Index listOfSons; - decl_node low; - decl_node high; - decl_node scope; - }; - -struct decl_subrangeT_r { - decl_node low; - decl_node high; - decl_node type; - decl_node scope; - }; - -struct decl_subscriptT_r { - decl_node type; - decl_node expr; - }; - -struct decl_arrayT_r { - decl_node subr; - decl_node type; - decl_node scope; - unsigned int isUnbounded; - }; - -struct decl_stringT_r { - nameKey_Name name; - unsigned int length; - unsigned int isCharCompatible; - DynamicStrings_String cstring; - unsigned int clength; - DynamicStrings_String cchar; - }; - -struct decl_literalT_r { - nameKey_Name name; - decl_node type; - }; - -struct decl_constT_r { - nameKey_Name name; - decl_node type; - decl_node value; - decl_node scope; - }; - -struct decl_varparamT_r { - decl_node namelist; - decl_node type; - decl_node scope; - unsigned int isUnbounded; - unsigned int isForC; - unsigned int isUsed; - }; - -struct decl_paramT_r { - decl_node namelist; - decl_node type; - decl_node scope; - unsigned int isUnbounded; - unsigned int isForC; - unsigned int isUsed; - }; - -struct decl_varargsT_r { - decl_node scope; - }; - -struct decl_optargT_r { - decl_node namelist; - decl_node type; - decl_node scope; - decl_node init; - }; - -struct decl_pointerT_r { - decl_node type; - decl_node scope; - }; - -struct decl_varientfieldT_r { - nameKey_Name name; - decl_node parent; - decl_node varient; - unsigned int simple; - Indexing_Index listOfSons; - decl_node scope; - }; - -struct decl_setT_r { - decl_node type; - decl_node scope; - }; - -struct decl_componentrefT_r { - decl_node rec; - decl_node field; - decl_node resultType; - }; - -struct decl_pointerrefT_r { - decl_node ptr; - decl_node field; - decl_node resultType; - }; - -struct decl_arrayrefT_r { - decl_node array; - decl_node index; - decl_node resultType; - }; - -struct decl_commentPair_r { - decl_node after; - decl_node body; - }; - -struct decl_loopT_r { - decl_node statements; - unsigned int labelno; - }; - -struct decl_caseT_r { - decl_node expression; - Indexing_Index caseLabelList; - decl_node else_; - }; - -struct decl_caselabellistT_r { - decl_node caseList; - decl_node statements; - }; - -struct decl_caselistT_r { - Indexing_Index rangePairs; - }; - -struct decl_rangeT_r { - decl_node lo; - decl_node hi; - }; - -struct decl_forT_r { - decl_node des; - decl_node start; - decl_node end; - decl_node increment; - decl_node statements; - }; - -struct decl_statementT_r { - Indexing_Index sequence; - }; - -struct decl_scopeT_r { - symbolKey_symbolTree symbols; - Indexing_Index constants; - Indexing_Index types; - Indexing_Index procedures; - Indexing_Index variables; - }; - -struct decl_proctypeT_r { - Indexing_Index parameters; - unsigned int returnopt; - unsigned int vararg; - decl_node optarg_; - decl_node scope; - decl_node returnType; - }; - -struct decl_binaryT_r { - decl_node left; - decl_node right; - decl_node resultType; - }; - -struct decl_unaryT_r { - decl_node arg; - decl_node resultType; - }; - -struct decl_where_r { - unsigned int defDeclared; - unsigned int modDeclared; - unsigned int firstUsed; - }; - -typedef void (*decl_nodeProcedure_t) (decl_node); -struct decl_nodeProcedure_p { decl_nodeProcedure_t proc; }; - -struct decl_cnameT_r { - nameKey_Name name; - unsigned int init; - }; - -struct Indexing__T5_r { - void *ArrayStart; - unsigned int ArraySize; - unsigned int Used; - unsigned int Low; - unsigned int High; - unsigned int Debug; - unsigned int Map; - }; - -struct mcComment__T6_r { - mcComment_commentType type; - DynamicStrings_String content; - nameKey_Name procName; - unsigned int used; - }; - -struct wlists__T10_a { unsigned int array[maxNoOfElements-1+1]; }; -struct DynamicStrings__T7_a { char array[(MaxBuf-1)+1]; }; -struct alists__T13_r { - unsigned int noOfelements; - alists__T14 elements; - alists_alist next; - }; - -struct decl_intrinsicT_r { - decl_node args; - unsigned int noArgs; - decl_node type; - decl_commentPair intrinsicComment; - unsigned int postUnreachable; - }; - -struct decl_funccallT_r { - decl_node function; - decl_node args; - decl_node type; - decl_commentPair funccallComment; - }; - -struct decl_returnT_r { - decl_node exp; - decl_node scope; - decl_commentPair returnComment; - }; - -struct decl_varT_r { - nameKey_Name name; - decl_node type; - decl_node decl; - decl_node scope; - unsigned int isInitialised; - unsigned int isParameter; - unsigned int isVarParameter; - unsigned int isUsed; - decl_cnameT cname; - }; - -struct decl_recordfieldT_r { - nameKey_Name name; - decl_node type; - unsigned int tag; - decl_node parent; - decl_node varient; - decl_node scope; - decl_cnameT cname; - }; - -struct decl_enumerationfieldT_r { - nameKey_Name name; - decl_node type; - decl_node scope; - unsigned int value; - decl_cnameT cname; - }; - -struct decl_assignmentT_r { - decl_node des; - decl_node expr; - decl_commentPair assignComment; - }; - -struct decl_ifT_r { - decl_node expr; - decl_node elsif; - decl_node then; - decl_node else_; - decl_commentPair ifComment; - decl_commentPair elseComment; - decl_commentPair endComment; - }; - -struct decl_elsifT_r { - decl_node expr; - decl_node elsif; - decl_node then; - decl_node else_; - decl_commentPair elseComment; - }; - -struct decl_whileT_r { - decl_node expr; - decl_node statements; - decl_commentPair doComment; - decl_commentPair endComment; - }; - -struct decl_repeatT_r { - decl_node expr; - decl_node statements; - decl_commentPair repeatComment; - decl_commentPair untilComment; - }; - -struct decl_procedureT_r { - nameKey_Name name; - decl_scopeT decls; - decl_node scope; - Indexing_Index parameters; - unsigned int isForC; - unsigned int built; - unsigned int checking; - unsigned int returnopt; - unsigned int vararg; - unsigned int noreturnused; - unsigned int noreturn; - unsigned int paramcount; - decl_node optarg_; - decl_node returnType; - decl_node beginStatements; - decl_cnameT cname; - mcComment_commentDesc defComment; - mcComment_commentDesc modComment; - }; - -struct decl_moduleT_r { - nameKey_Name name; - nameKey_Name source; - Indexing_Index importedModules; - decl_fixupInfo constFixup; - decl_fixupInfo enumFixup; - decl_scopeT decls; - decl_node beginStatements; - decl_node finallyStatements; - unsigned int enumsComplete; - unsigned int constsComplete; - unsigned int visited; - decl_commentPair com; - }; - -struct decl_defT_r { - nameKey_Name name; - nameKey_Name source; - unsigned int hasHidden; - unsigned int forC; - Indexing_Index exported; - Indexing_Index importedModules; - decl_fixupInfo constFixup; - decl_fixupInfo enumFixup; - decl_scopeT decls; - unsigned int enumsComplete; - unsigned int constsComplete; - unsigned int visited; - decl_commentPair com; - }; - -struct decl_impT_r { - nameKey_Name name; - nameKey_Name source; - Indexing_Index importedModules; - decl_fixupInfo constFixup; - decl_fixupInfo enumFixup; - decl_node beginStatements; - decl_node finallyStatements; - decl_node definitionModule; - decl_scopeT decls; - unsigned int enumsComplete; - unsigned int constsComplete; - unsigned int visited; - decl_commentPair com; - }; - -struct DynamicStrings_Contents_r { - DynamicStrings__T7 buf; - unsigned int len; - DynamicStrings_String next; - }; - -struct wlists__T9_r { - unsigned int noOfElements; - wlists__T10 elements; - wlists_wlist next; - }; - -struct mcPretty__T12_r { - mcPretty_writeProc write_; - mcPretty_writeLnProc writeln; - unsigned int needsSpace; - unsigned int needsIndent; - unsigned int seekPos; - unsigned int curLine; - unsigned int curPos; - unsigned int indent; - mcPretty_pretty stacked; - }; - -typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor; - -typedef DynamicStrings_descriptor *DynamicStrings_Descriptor; - -typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo; - -typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState; - -struct DynamicStrings_descriptor_r { - unsigned int charStarUsed; - void *charStar; - unsigned int charStarSize; - unsigned int charStarValid; - DynamicStrings_desState state; - DynamicStrings_String garbage; - }; - -struct DynamicStrings_DebugInfo_r { - DynamicStrings_String next; - void *file; - unsigned int line; - void *proc; - }; - -struct decl_nodeRec_r { - decl_nodeT kind; /* case tag */ - union { - decl_intrinsicT intrinsicF; - decl_explistT explistF; - decl_exitT exitF; - decl_returnT returnF; - decl_stmtT stmtF; - decl_commentT commentF; - decl_typeT typeF; - decl_recordT recordF; - decl_varientT varientF; - decl_varT varF; - decl_enumerationT enumerationF; - decl_subrangeT subrangeF; - decl_subscriptT subscriptF; - decl_arrayT arrayF; - decl_stringT stringF; - decl_constT constF; - decl_literalT literalF; - decl_varparamT varparamF; - decl_paramT paramF; - decl_varargsT varargsF; - decl_optargT optargF; - decl_pointerT pointerF; - decl_recordfieldT recordfieldF; - decl_varientfieldT varientfieldF; - decl_enumerationfieldT enumerationfieldF; - decl_setT setF; - decl_proctypeT proctypeF; - decl_procedureT procedureF; - decl_defT defF; - decl_impT impF; - decl_moduleT moduleF; - decl_loopT loopF; - decl_whileT whileF; - decl_forT forF; - decl_repeatT repeatF; - decl_caseT caseF; - decl_caselabellistT caselabellistF; - decl_caselistT caselistF; - decl_rangeT rangeF; - decl_ifT ifF; - decl_elsifT elsifF; - decl_assignmentT assignmentF; - decl_arrayrefT arrayrefF; - decl_pointerrefT pointerrefF; - decl_componentrefT componentrefF; - decl_binaryT binaryF; - decl_unaryT unaryF; - decl_identlistT identlistF; - decl_vardeclT vardeclF; - decl_funccallT funccallF; - decl_setvalueT setvalueF; - }; - decl_where at; - }; - -struct DynamicStrings_stringRecord_r { - DynamicStrings_Contents contents; - DynamicStrings_Descriptor head; - DynamicStrings_DebugInfo debug; - }; - -static FIO_File outputFile; -static decl_language lang; -static decl_node bitsperunitN; -static decl_node bitsperwordN; -static decl_node bitspercharN; -static decl_node unitsperwordN; -static decl_node mainModule; -static decl_node currentModule; -static decl_node defModule; -static decl_node systemN; -static decl_node addressN; -static decl_node locN; -static decl_node byteN; -static decl_node wordN; -static decl_node csizetN; -static decl_node cssizetN; -static decl_node adrN; -static decl_node sizeN; -static decl_node tsizeN; -static decl_node newN; -static decl_node disposeN; -static decl_node lengthN; -static decl_node incN; -static decl_node decN; -static decl_node inclN; -static decl_node exclN; -static decl_node highN; -static decl_node m2rtsN; -static decl_node haltN; -static decl_node throwN; -static decl_node chrN; -static decl_node capN; -static decl_node absN; -static decl_node floatN; -static decl_node truncN; -static decl_node ordN; -static decl_node valN; -static decl_node minN; -static decl_node maxN; -static decl_node booleanN; -static decl_node procN; -static decl_node charN; -static decl_node integerN; -static decl_node cardinalN; -static decl_node longcardN; -static decl_node shortcardN; -static decl_node longintN; -static decl_node shortintN; -static decl_node bitsetN; -static decl_node bitnumN; -static decl_node ztypeN; -static decl_node rtypeN; -static decl_node complexN; -static decl_node longcomplexN; -static decl_node shortcomplexN; -static decl_node cmplxN; -static decl_node reN; -static decl_node imN; -static decl_node realN; -static decl_node longrealN; -static decl_node shortrealN; -static decl_node nilN; -static decl_node trueN; -static decl_node falseN; -static Indexing_Index scopeStack; -static Indexing_Index defUniverseI; -static Indexing_Index modUniverseI; -static symbolKey_symbolTree modUniverse; -static symbolKey_symbolTree defUniverse; -static symbolKey_symbolTree baseSymbols; -static decl_outputStates outputState; -static mcPretty_pretty doP; -static alists_alist todoQ; -static alists_alist partialQ; -static alists_alist doneQ; -static unsigned int mustVisitScope; -static unsigned int simplified; -static unsigned int tempCount; -static decl_node globalNode; -extern "C" void SYSTEM_ShiftVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int ShiftCount); -extern "C" void SYSTEM_ShiftLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount); -extern "C" void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount); -extern "C" void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount); -extern "C" void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount); -extern "C" void SYSTEM_RotateRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount); -extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); -extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); -extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies); -extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname); -extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p); -extern "C" void M2RTS_ExecuteInitialProcedures (void); -extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p); -extern "C" void M2RTS_ExecuteTerminationProcedures (void); -extern "C" void M2RTS_Terminate (void) __attribute__ ((noreturn)); -extern "C" void M2RTS_HALT (int exitcode) __attribute__ ((noreturn)); -extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn)); -extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn)); -extern "C" void M2RTS_ExitOnHalt (int e); -extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn)); -extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high); -extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); -extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn)); - -/* - getDeclaredMod - returns the token number associated with the nodes declaration - in the implementation or program module. -*/ - -extern "C" unsigned int decl_getDeclaredMod (decl_node n); - -/* - getDeclaredDef - returns the token number associated with the nodes declaration - in the definition module. -*/ - -extern "C" unsigned int decl_getDeclaredDef (decl_node n); - -/* - getFirstUsed - returns the token number associated with the first use of - node, n. -*/ - -extern "C" unsigned int decl_getFirstUsed (decl_node n); - -/* - isDef - return TRUE if node, n, is a definition module. -*/ - -extern "C" unsigned int decl_isDef (decl_node n); - -/* - isImp - return TRUE if node, n, is an implementation module. -*/ - -extern "C" unsigned int decl_isImp (decl_node n); - -/* - isImpOrModule - returns TRUE if, n, is a program module or implementation module. -*/ - -extern "C" unsigned int decl_isImpOrModule (decl_node n); - -/* - isVisited - returns TRUE if the node was visited. -*/ - -extern "C" unsigned int decl_isVisited (decl_node n); - -/* - unsetVisited - unset the visited flag on a def/imp/module node. -*/ - -extern "C" void decl_unsetVisited (decl_node n); - -/* - setVisited - set the visited flag on a def/imp/module node. -*/ - -extern "C" void decl_setVisited (decl_node n); - -/* - setEnumsComplete - sets the field inside the def or imp or module, n. -*/ - -extern "C" void decl_setEnumsComplete (decl_node n); - -/* - getEnumsComplete - gets the field from the def or imp or module, n. -*/ - -extern "C" unsigned int decl_getEnumsComplete (decl_node n); - -/* - resetEnumPos - resets the index into the saved list of enums inside - module, n. -*/ - -extern "C" void decl_resetEnumPos (decl_node n); - -/* - getNextEnum - returns the next enumeration node. -*/ - -extern "C" decl_node decl_getNextEnum (void); - -/* - isModule - return TRUE if node, n, is a program module. -*/ - -extern "C" unsigned int decl_isModule (decl_node n); - -/* - isMainModule - return TRUE if node, n, is the main module specified - by the source file. This might be a definition, - implementation or program module. -*/ - -extern "C" unsigned int decl_isMainModule (decl_node n); - -/* - setMainModule - sets node, n, as the main module to be compiled. -*/ - -extern "C" void decl_setMainModule (decl_node n); - -/* - setCurrentModule - sets node, n, as the current module being compiled. -*/ - -extern "C" void decl_setCurrentModule (decl_node n); - -/* - lookupDef - returns a definition module node named, n. -*/ - -extern "C" decl_node decl_lookupDef (nameKey_Name n); - -/* - lookupImp - returns an implementation module node named, n. -*/ - -extern "C" decl_node decl_lookupImp (nameKey_Name n); - -/* - lookupModule - returns a module node named, n. -*/ - -extern "C" decl_node decl_lookupModule (nameKey_Name n); - -/* - putDefForC - the definition module was defined FOR "C". -*/ - -extern "C" void decl_putDefForC (decl_node n); - -/* - lookupInScope - looks up a symbol named, n, from, scope. -*/ - -extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n); - -/* - isConst - returns TRUE if node, n, is a const. -*/ - -extern "C" unsigned int decl_isConst (decl_node n); - -/* - isType - returns TRUE if node, n, is a type. -*/ - -extern "C" unsigned int decl_isType (decl_node n); - -/* - putType - places, exp, as the type alias to des. - TYPE des = exp ; -*/ - -extern "C" void decl_putType (decl_node des, decl_node exp); - -/* - getType - returns the type associated with node, n. -*/ - -extern "C" decl_node decl_getType (decl_node n); - -/* - skipType - skips over type aliases. -*/ - -extern "C" decl_node decl_skipType (decl_node n); - -/* - putTypeHidden - marks type, des, as being a hidden type. - TYPE des ; -*/ - -extern "C" void decl_putTypeHidden (decl_node des); - -/* - isTypeHidden - returns TRUE if type, n, is hidden. -*/ - -extern "C" unsigned int decl_isTypeHidden (decl_node n); - -/* - hasHidden - returns TRUE if module, n, has a hidden type. -*/ - -extern "C" unsigned int decl_hasHidden (decl_node n); - -/* - isVar - returns TRUE if node, n, is a type. -*/ - -extern "C" unsigned int decl_isVar (decl_node n); - -/* - isTemporary - returns TRUE if node, n, is a variable and temporary. -*/ - -extern "C" unsigned int decl_isTemporary (decl_node n); - -/* - isExported - returns TRUE if symbol, n, is exported from - the definition module. -*/ - -extern "C" unsigned int decl_isExported (decl_node n); - -/* - getDeclScope - returns the node representing the - current declaration scope. -*/ - -extern "C" decl_node decl_getDeclScope (void); - -/* - getScope - returns the scope associated with node, n. -*/ - -extern "C" decl_node decl_getScope (decl_node n); - -/* - isLiteral - returns TRUE if, n, is a literal. -*/ - -extern "C" unsigned int decl_isLiteral (decl_node n); - -/* - isConstSet - returns TRUE if, n, is a constant set. -*/ - -extern "C" unsigned int decl_isConstSet (decl_node n); - -/* - isEnumerationField - returns TRUE if, n, is an enumeration field. -*/ - -extern "C" unsigned int decl_isEnumerationField (decl_node n); - -/* - isEnumeration - returns TRUE if node, n, is an enumeration type. -*/ - -extern "C" unsigned int decl_isEnumeration (decl_node n); - -/* - isUnbounded - returns TRUE if, n, is an unbounded array. -*/ - -extern "C" unsigned int decl_isUnbounded (decl_node n); - -/* - isParameter - returns TRUE if, n, is a parameter. -*/ - -extern "C" unsigned int decl_isParameter (decl_node n); - -/* - isVarParam - returns TRUE if, n, is a var parameter. -*/ - -extern "C" unsigned int decl_isVarParam (decl_node n); - -/* - isParam - returns TRUE if, n, is a non var parameter. -*/ - -extern "C" unsigned int decl_isParam (decl_node n); - -/* - isNonVarParam - is an alias to isParam. -*/ - -extern "C" unsigned int decl_isNonVarParam (decl_node n); - -/* - addOptParameter - returns an optarg which has been created and added to - procedure node, proc. It has a name, id, and, type, - and an initial value, init. -*/ - -extern "C" decl_node decl_addOptParameter (decl_node proc, nameKey_Name id, decl_node type, decl_node init); - -/* - isOptarg - returns TRUE if, n, is an optarg. -*/ - -extern "C" unsigned int decl_isOptarg (decl_node n); - -/* - isRecord - returns TRUE if, n, is a record. -*/ - -extern "C" unsigned int decl_isRecord (decl_node n); - -/* - isRecordField - returns TRUE if, n, is a record field. -*/ - -extern "C" unsigned int decl_isRecordField (decl_node n); - -/* - isVarientField - returns TRUE if, n, is a varient field. -*/ - -extern "C" unsigned int decl_isVarientField (decl_node n); - -/* - isArray - returns TRUE if, n, is an array. -*/ - -extern "C" unsigned int decl_isArray (decl_node n); - -/* - isProcType - returns TRUE if, n, is a procedure type. -*/ - -extern "C" unsigned int decl_isProcType (decl_node n); - -/* - isPointer - returns TRUE if, n, is a pointer. -*/ - -extern "C" unsigned int decl_isPointer (decl_node n); - -/* - isProcedure - returns TRUE if, n, is a procedure. -*/ - -extern "C" unsigned int decl_isProcedure (decl_node n); - -/* - isVarient - returns TRUE if, n, is a varient record. -*/ - -extern "C" unsigned int decl_isVarient (decl_node n); - -/* - isSet - returns TRUE if, n, is a set type. -*/ - -extern "C" unsigned int decl_isSet (decl_node n); - -/* - isSubrange - returns TRUE if, n, is a subrange type. -*/ - -extern "C" unsigned int decl_isSubrange (decl_node n); - -/* - isZtype - returns TRUE if, n, is the Z type. -*/ - -extern "C" unsigned int decl_isZtype (decl_node n); - -/* - isRtype - returns TRUE if, n, is the R type. -*/ - -extern "C" unsigned int decl_isRtype (decl_node n); - -/* - makeConst - create, initialise and return a const node. -*/ - -extern "C" decl_node decl_makeConst (nameKey_Name n); - -/* - putConst - places value, v, into node, n. -*/ - -extern "C" void decl_putConst (decl_node n, decl_node v); - -/* - makeType - create, initialise and return a type node. -*/ - -extern "C" decl_node decl_makeType (nameKey_Name n); - -/* - makeTypeImp - lookup a type in the definition module - and return it. Otherwise create a new type. -*/ - -extern "C" decl_node decl_makeTypeImp (nameKey_Name n); - -/* - makeVar - create, initialise and return a var node. -*/ - -extern "C" decl_node decl_makeVar (nameKey_Name n); - -/* - putVar - places, type, as the type for var. -*/ - -extern "C" void decl_putVar (decl_node var, decl_node type, decl_node decl); - -/* - makeVarDecl - create a vardecl node and create a shadow variable in the - current scope. -*/ - -extern "C" decl_node decl_makeVarDecl (decl_node i, decl_node type); - -/* - makeEnum - creates an enumerated type and returns the node. -*/ - -extern "C" decl_node decl_makeEnum (void); - -/* - makeEnumField - returns an enumeration field, named, n. -*/ - -extern "C" decl_node decl_makeEnumField (decl_node e, nameKey_Name n); - -/* - makeSubrange - returns a subrange node, built from range: low..high. -*/ - -extern "C" decl_node decl_makeSubrange (decl_node low, decl_node high); - -/* - putSubrangeType - assigns, type, to the subrange type, sub. -*/ - -extern "C" void decl_putSubrangeType (decl_node sub, decl_node type); - -/* - makePointer - returns a pointer of, type, node. -*/ - -extern "C" decl_node decl_makePointer (decl_node type); - -/* - makeSet - returns a set of, type, node. -*/ - -extern "C" decl_node decl_makeSet (decl_node type); - -/* - makeArray - returns a node representing ARRAY subr OF type. -*/ - -extern "C" decl_node decl_makeArray (decl_node subr, decl_node type); - -/* - putUnbounded - sets array, n, as unbounded. -*/ - -extern "C" void decl_putUnbounded (decl_node n); - -/* - makeRecord - creates and returns a record node. -*/ - -extern "C" decl_node decl_makeRecord (void); - -/* - makeVarient - creates a new symbol, a varient symbol for record or varient field - symbol, r. -*/ - -extern "C" decl_node decl_makeVarient (decl_node r); - -/* - addFieldsToRecord - adds fields, i, of type, t, into a record, r. - It returns, r. -*/ - -extern "C" decl_node decl_addFieldsToRecord (decl_node r, decl_node v, decl_node i, decl_node t); - -/* - buildVarientSelector - builds a field of name, tag, of, type onto: - record or varient field, r. - varient, v. -*/ - -extern "C" void decl_buildVarientSelector (decl_node r, decl_node v, nameKey_Name tag, decl_node type); - -/* - buildVarientFieldRecord - builds a varient field into a varient symbol, v. - The varient field is returned. -*/ - -extern "C" decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p); - -/* - getSymName - returns the name of symbol, n. -*/ - -extern "C" nameKey_Name decl_getSymName (decl_node n); - -/* - import - attempts to add node, n, into the scope of module, m. - It might fail due to a name clash in which case the - previous named symbol is returned. On success, n, - is returned. -*/ - -extern "C" decl_node decl_import (decl_node m, decl_node n); - -/* - lookupExported - attempts to lookup a node named, i, from definition - module, n. The node is returned if found. - NIL is returned if not found. -*/ - -extern "C" decl_node decl_lookupExported (decl_node n, nameKey_Name i); - -/* - lookupSym - returns the symbol named, n, from the scope stack. -*/ - -extern "C" decl_node decl_lookupSym (nameKey_Name n); - -/* - addImportedModule - add module, i, to be imported by, m. - If scoped then module, i, is added to the - module, m, scope. -*/ - -extern "C" void decl_addImportedModule (decl_node m, decl_node i, unsigned int scoped); - -/* - setSource - sets the source filename for module, n, to s. -*/ - -extern "C" void decl_setSource (decl_node n, nameKey_Name s); - -/* - getSource - returns the source filename for module, n. -*/ - -extern "C" nameKey_Name decl_getSource (decl_node n); - -/* - getMainModule - returns the main module node. -*/ - -extern "C" decl_node decl_getMainModule (void); - -/* - getCurrentModule - returns the current module being compiled. -*/ - -extern "C" decl_node decl_getCurrentModule (void); - -/* - foreachDefModuleDo - foreach definition node, n, in the module universe, - call p (n). -*/ - -extern "C" void decl_foreachDefModuleDo (symbolKey_performOperation p); - -/* - foreachModModuleDo - foreach implementation or module node, n, in the module universe, - call p (n). -*/ - -extern "C" void decl_foreachModModuleDo (symbolKey_performOperation p); - -/* - enterScope - pushes symbol, n, to the scope stack. -*/ - -extern "C" void decl_enterScope (decl_node n); - -/* - leaveScope - removes the top level scope. -*/ - -extern "C" void decl_leaveScope (void); - -/* - makeProcedure - create, initialise and return a procedure node. -*/ - -extern "C" decl_node decl_makeProcedure (nameKey_Name n); - -/* - putCommentDefProcedure - remembers the procedure comment (if it exists) as a - definition module procedure heading. NIL is placed - if there is no procedure comment available. -*/ - -extern "C" void decl_putCommentDefProcedure (decl_node n); - -/* - putCommentModProcedure - remembers the procedure comment (if it exists) as an - implementation/program module procedure heading. NIL is placed - if there is no procedure comment available. -*/ - -extern "C" void decl_putCommentModProcedure (decl_node n); - -/* - makeProcType - returns a proctype node. -*/ - -extern "C" decl_node decl_makeProcType (void); - -/* - putReturnType - sets the return type of procedure or proctype, proc, to, type. -*/ - -extern "C" void decl_putReturnType (decl_node proc, decl_node type); - -/* - putOptReturn - sets, proctype or procedure, proc, to have an optional return type. -*/ - -extern "C" void decl_putOptReturn (decl_node proc); - -/* - makeVarParameter - returns a var parameter node with, name: type. -*/ - -extern "C" decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused); - -/* - makeNonVarParameter - returns a non var parameter node with, name: type. -*/ - -extern "C" decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused); - -/* - paramEnter - reset the parameter count. -*/ - -extern "C" void decl_paramEnter (decl_node n); - -/* - paramLeave - set paramater checking to TRUE from now onwards. -*/ - -extern "C" void decl_paramLeave (decl_node n); - -/* - makeIdentList - returns a node which will be used to maintain an ident list. -*/ - -extern "C" decl_node decl_makeIdentList (void); - -/* - putIdent - places ident, i, into identlist, n. It returns TRUE if - ident, i, is unique. -*/ - -extern "C" unsigned int decl_putIdent (decl_node n, nameKey_Name i); - -/* - addVarParameters - adds the identlist, i, of, type, to be VAR parameters - in procedure, n. -*/ - -extern "C" void decl_addVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused); - -/* - addNonVarParameters - adds the identlist, i, of, type, to be parameters - in procedure, n. -*/ - -extern "C" void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused); - -/* - makeVarargs - returns a varargs node. -*/ - -extern "C" decl_node decl_makeVarargs (void); - -/* - isVarargs - returns TRUE if, n, is a varargs node. -*/ - -extern "C" unsigned int decl_isVarargs (decl_node n); - -/* - addParameter - adds a parameter, param, to procedure or proctype, proc. -*/ - -extern "C" void decl_addParameter (decl_node proc, decl_node param); - -/* - makeBinaryTok - creates and returns a boolean type node with, - l, and, r, nodes. -*/ - -extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, decl_node r); - -/* - makeUnaryTok - creates and returns a boolean type node with, - e, node. -*/ - -extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e); - -/* - makeComponentRef - build a componentref node which accesses, field, - within, record, rec. -*/ - -extern "C" decl_node decl_makeComponentRef (decl_node rec, decl_node field); - -/* - makePointerRef - build a pointerref node which accesses, field, - within, pointer to record, ptr. -*/ - -extern "C" decl_node decl_makePointerRef (decl_node ptr, decl_node field); - -/* - isPointerRef - returns TRUE if, n, is a pointerref node. -*/ - -extern "C" unsigned int decl_isPointerRef (decl_node n); - -/* - makeDeRef - dereferences the pointer defined by, n. -*/ - -extern "C" decl_node decl_makeDeRef (decl_node n); - -/* - makeArrayRef - build an arrayref node which access element, - index, in, array. array is a variable/expression/constant - which has a type array. -*/ - -extern "C" decl_node decl_makeArrayRef (decl_node array, decl_node index); - -/* - getLastOp - return the right most non leaf node. -*/ - -extern "C" decl_node decl_getLastOp (decl_node n); - -/* - getCardinal - returns the cardinal type node. -*/ - -extern "C" decl_node decl_getCardinal (void); - -/* - makeLiteralInt - creates and returns a literal node based on an integer type. -*/ - -extern "C" decl_node decl_makeLiteralInt (nameKey_Name n); - -/* - makeLiteralReal - creates and returns a literal node based on a real type. -*/ - -extern "C" decl_node decl_makeLiteralReal (nameKey_Name n); - -/* - makeString - creates and returns a node containing string, n. -*/ - -extern "C" decl_node decl_makeString (nameKey_Name n); - -/* - makeSetValue - creates and returns a setvalue node. -*/ - -extern "C" decl_node decl_makeSetValue (void); - -/* - isSetValue - returns TRUE if, n, is a setvalue node. -*/ - -extern "C" unsigned int decl_isSetValue (decl_node n); - -/* - putSetValue - assigns the type, t, to the set value, n. The - node, n, is returned. -*/ - -extern "C" decl_node decl_putSetValue (decl_node n, decl_node t); - -/* - includeSetValue - includes the range l..h into the setvalue. - h might be NIL indicating that a single element - is to be included into the set. - n is returned. -*/ - -extern "C" decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h); - -/* - getBuiltinConst - creates and returns a builtin const if available. -*/ - -extern "C" decl_node decl_getBuiltinConst (nameKey_Name n); - -/* - makeExpList - creates and returns an expList node. -*/ - -extern "C" decl_node decl_makeExpList (void); - -/* - isExpList - returns TRUE if, n, is an explist node. -*/ - -extern "C" unsigned int decl_isExpList (decl_node n); - -/* - putExpList - places, expression, e, within the explist, n. -*/ - -extern "C" void decl_putExpList (decl_node n, decl_node e); - -/* - makeConstExp - returns a constexp node. -*/ - -extern "C" decl_node decl_makeConstExp (void); - -/* - getNextConstExp - returns the next constexp node. -*/ - -extern "C" decl_node decl_getNextConstExp (void); - -/* - setConstExpComplete - sets the field inside the def or imp or module, n. -*/ - -extern "C" void decl_setConstExpComplete (decl_node n); - -/* - fixupConstExp - assign fixup expression, e, into the argument of, c. -*/ - -extern "C" decl_node decl_fixupConstExp (decl_node c, decl_node e); - -/* - resetConstExpPos - resets the index into the saved list of constexps inside - module, n. -*/ - -extern "C" void decl_resetConstExpPos (decl_node n); - -/* - makeFuncCall - builds a function call to c with param list, n. -*/ - -extern "C" decl_node decl_makeFuncCall (decl_node c, decl_node n); - -/* - makeStatementSequence - create and return a statement sequence node. -*/ - -extern "C" decl_node decl_makeStatementSequence (void); - -/* - isStatementSequence - returns TRUE if node, n, is a statement sequence. -*/ - -extern "C" unsigned int decl_isStatementSequence (decl_node n); - -/* - addStatement - adds node, n, as a statement to statememt sequence, s. -*/ - -extern "C" void decl_addStatement (decl_node s, decl_node n); - -/* - addCommentBody - adds a body comment to a statement sequence node. -*/ - -extern "C" void decl_addCommentBody (decl_node n); - -/* - addCommentAfter - adds an after comment to a statement sequence node. -*/ - -extern "C" void decl_addCommentAfter (decl_node n); - -/* - addIfComments - adds the, body, and, after, comments to if node, n. -*/ - -extern "C" void decl_addIfComments (decl_node n, decl_node body, decl_node after); - -/* - addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n. -*/ - -extern "C" void decl_addElseComments (decl_node n, decl_node body, decl_node after); - -/* - addIfEndComments - adds the, body, and, after, comments to an, if, node, n. -*/ - -extern "C" void decl_addIfEndComments (decl_node n, decl_node body, decl_node after); - -/* - makeReturn - creates and returns a return node. -*/ - -extern "C" decl_node decl_makeReturn (void); - -/* - isReturn - returns TRUE if node, n, is a return. -*/ - -extern "C" unsigned int decl_isReturn (decl_node n); - -/* - putReturn - assigns node, e, as the expression on the return node. -*/ - -extern "C" void decl_putReturn (decl_node n, decl_node e); - -/* - makeWhile - creates and returns a while node. -*/ - -extern "C" decl_node decl_makeWhile (void); - -/* - putWhile - places an expression, e, and statement sequence, s, into the while - node, n. -*/ - -extern "C" void decl_putWhile (decl_node n, decl_node e, decl_node s); - -/* - isWhile - returns TRUE if node, n, is a while. -*/ - -extern "C" unsigned int decl_isWhile (decl_node n); - -/* - addWhileDoComment - adds body and after comments to while node, w. -*/ - -extern "C" void decl_addWhileDoComment (decl_node w, decl_node body, decl_node after); - -/* - addWhileEndComment - adds body and after comments to the end of a while node, w. -*/ - -extern "C" void decl_addWhileEndComment (decl_node w, decl_node body, decl_node after); - -/* - makeAssignment - creates and returns an assignment node. - The designator is, d, and expression, e. -*/ - -extern "C" decl_node decl_makeAssignment (decl_node d, decl_node e); - -/* - putBegin - assigns statements, s, to be the normal part in - block, b. The block may be a procedure or module, - or implementation node. -*/ - -extern "C" void decl_putBegin (decl_node b, decl_node s); - -/* - putFinally - assigns statements, s, to be the final part in - block, b. The block may be a module - or implementation node. -*/ - -extern "C" void decl_putFinally (decl_node b, decl_node s); - -/* - makeExit - creates and returns an exit node. -*/ - -extern "C" decl_node decl_makeExit (decl_node l, unsigned int n); - -/* - isExit - returns TRUE if node, n, is an exit. -*/ - -extern "C" unsigned int decl_isExit (decl_node n); - -/* - makeLoop - creates and returns a loop node. -*/ - -extern "C" decl_node decl_makeLoop (void); - -/* - isLoop - returns TRUE if, n, is a loop node. -*/ - -extern "C" unsigned int decl_isLoop (decl_node n); - -/* - putLoop - places statement sequence, s, into loop, l. -*/ - -extern "C" void decl_putLoop (decl_node l, decl_node s); - -/* - makeComment - creates and returns a comment node. -*/ - -extern "C" decl_node decl_makeComment (const char *a_, unsigned int _a_high); - -/* - makeCommentS - creates and returns a comment node. -*/ - -extern "C" decl_node decl_makeCommentS (mcComment_commentDesc c); - -/* - makeIf - creates and returns an if node. The if node - will have expression, e, and statement sequence, s, - as the then component. -*/ - -extern "C" decl_node decl_makeIf (decl_node e, decl_node s); - -/* - isIf - returns TRUE if, n, is an if node. -*/ - -extern "C" unsigned int decl_isIf (decl_node n); - -/* - makeElsif - creates and returns an elsif node. - This node has an expression, e, and statement - sequence, s. -*/ - -extern "C" decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s); - -/* - isElsif - returns TRUE if node, n, is an elsif node. -*/ - -extern "C" unsigned int decl_isElsif (decl_node n); - -/* - putElse - the else is grafted onto the if/elsif node, i, - and the statement sequence will be, s. -*/ - -extern "C" void decl_putElse (decl_node i, decl_node s); - -/* - makeFor - creates and returns a for node. -*/ - -extern "C" decl_node decl_makeFor (void); - -/* - isFor - returns TRUE if node, n, is a for node. -*/ - -extern "C" unsigned int decl_isFor (decl_node n); - -/* - putFor - assigns the fields of the for node with - ident, i, - start, s, - end, e, - increment, i, - statements, sq. -*/ - -extern "C" void decl_putFor (decl_node f, decl_node i, decl_node s, decl_node e, decl_node b, decl_node sq); - -/* - makeRepeat - creates and returns a repeat node. -*/ - -extern "C" decl_node decl_makeRepeat (void); - -/* - isRepeat - returns TRUE if node, n, is a repeat node. -*/ - -extern "C" unsigned int decl_isRepeat (decl_node n); - -/* - putRepeat - places statements, s, and expression, e, into - repeat statement, n. -*/ - -extern "C" void decl_putRepeat (decl_node n, decl_node s, decl_node e); - -/* - addRepeatComment - adds body and after comments to repeat node, r. -*/ - -extern "C" void decl_addRepeatComment (decl_node r, decl_node body, decl_node after); - -/* - addUntilComment - adds body and after comments to the until section of a repeat node, r. -*/ - -extern "C" void decl_addUntilComment (decl_node r, decl_node body, decl_node after); - -/* - makeCase - builds and returns a case statement node. -*/ - -extern "C" decl_node decl_makeCase (void); - -/* - isCase - returns TRUE if node, n, is a case statement. -*/ - -extern "C" unsigned int decl_isCase (decl_node n); - -/* - putCaseExpression - places expression, e, into case statement, n. - n is returned. -*/ - -extern "C" decl_node decl_putCaseExpression (decl_node n, decl_node e); - -/* - putCaseElse - places else statement, e, into case statement, n. - n is returned. -*/ - -extern "C" decl_node decl_putCaseElse (decl_node n, decl_node e); - -/* - putCaseStatement - places a caselist, l, and associated - statement sequence, s, into case statement, n. - n is returned. -*/ - -extern "C" decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s); - -/* - makeCaseLabelList - creates and returns a caselabellist node. -*/ - -extern "C" decl_node decl_makeCaseLabelList (decl_node l, decl_node s); - -/* - isCaseLabelList - returns TRUE if, n, is a caselabellist. -*/ - -extern "C" unsigned int decl_isCaseLabelList (decl_node n); - -/* - makeCaseList - creates and returns a case statement node. -*/ - -extern "C" decl_node decl_makeCaseList (void); - -/* - isCaseList - returns TRUE if, n, is a case list. -*/ - -extern "C" unsigned int decl_isCaseList (decl_node n); - -/* - putCaseRange - places the case range lo..hi into caselist, n. -*/ - -extern "C" decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi); - -/* - makeRange - creates and returns a case range. -*/ - -extern "C" decl_node decl_makeRange (decl_node lo, decl_node hi); - -/* - isRange - returns TRUE if node, n, is a range. -*/ - -extern "C" unsigned int decl_isRange (decl_node n); - -/* - setNoReturn - sets noreturn field inside procedure. -*/ - -extern "C" void decl_setNoReturn (decl_node n, unsigned int value); - -/* - dupExpr - duplicate the expression nodes, it does not duplicate - variables, literals, constants but only the expression - operators (including function calls and parameter lists). -*/ - -extern "C" decl_node decl_dupExpr (decl_node n); - -/* - setLangC - -*/ - -extern "C" void decl_setLangC (void); - -/* - setLangCP - -*/ - -extern "C" void decl_setLangCP (void); - -/* - setLangM2 - -*/ - -extern "C" void decl_setLangM2 (void); - -/* - out - walks the tree of node declarations for the main module - and writes the output to the outputFile specified in - mcOptions. It outputs the declarations in the language - specified above. -*/ - -extern "C" void decl_out (void); -extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high); -extern "C" nameKey_Name nameKey_makekey (void * a); -extern "C" void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high); -extern "C" unsigned int nameKey_lengthKey (nameKey_Name key); -extern "C" unsigned int nameKey_isKey (const char *a_, unsigned int _a_high); -extern "C" void nameKey_writeKey (nameKey_Name key); -extern "C" unsigned int nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2); -extern "C" void * nameKey_keyToCharStar (nameKey_Name key); -extern "C" symbolKey_symbolTree symbolKey_initTree (void); -extern "C" void symbolKey_killTree (symbolKey_symbolTree *t); -extern "C" void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name); -extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key); - -/* - delSymKey - deletes an entry in the binary tree. - - NB in order for this to work we must ensure that the InitTree sets - both left and right to NIL. -*/ - -extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name); - -/* - isEmptyTree - returns true if symbolTree, t, is empty. -*/ - -extern "C" unsigned int symbolKey_isEmptyTree (symbolKey_symbolTree t); - -/* - doesTreeContainAny - returns true if symbolTree, t, contains any - symbols which in turn return true when procedure, - p, is called with a symbol as its parameter. - The symbolTree root is empty apart from the field, - left, hence we need two procedures. -*/ - -extern "C" unsigned int symbolKey_doesTreeContainAny (symbolKey_symbolTree t, symbolKey_isSymbol p); - -/* - foreachNodeDo - for each node in symbolTree, t, a procedure, p, - is called with the node symbol as its parameter. - The tree root node only contains a legal left pointer, - therefore we need two procedures to examine this tree. -*/ - -extern "C" void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p); - -/* - initComment - the start of a new comment has been seen by the lexical analyser. - A new comment block is created and all addText contents are placed - in this block. onlySpaces indicates whether we have only seen - spaces on this line. -*/ - -extern "C" mcComment_commentDesc mcComment_initComment (unsigned int onlySpaces); - -/* - addText - cs is a C string (null terminated) which contains comment text. - This is appended to the comment, cd. -*/ - -extern "C" void mcComment_addText (mcComment_commentDesc cd, void * cs); - -/* - getContent - returns the content of comment, cd. -*/ - -extern "C" DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd); - -/* - getCommentCharStar - returns the C string content of comment, cd. -*/ - -extern "C" void * mcComment_getCommentCharStar (mcComment_commentDesc cd); - -/* - setProcedureComment - changes the type of comment, cd, to a - procedure heading comment, - providing it has the procname as the first word. -*/ - -extern "C" void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname); - -/* - getProcedureComment - returns the current procedure comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd); - -/* - getAfterStatementComment - returns the current statement after comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd); - -/* - getInbodyStatementComment - returns the current statement after comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd); - -/* - isProcedureComment - returns TRUE if, cd, is a procedure comment. -*/ - -extern "C" unsigned int mcComment_isProcedureComment (mcComment_commentDesc cd); - -/* - isBodyComment - returns TRUE if, cd, is a body comment. -*/ - -extern "C" unsigned int mcComment_isBodyComment (mcComment_commentDesc cd); - -/* - isAfterComment - returns TRUE if, cd, is an after comment. -*/ - -extern "C" unsigned int mcComment_isAfterComment (mcComment_commentDesc cd); -extern "C" void mcDebug_assert (unsigned int q); -extern "C" void mcDebug_writeDebug (const char *a_, unsigned int _a_high); -extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size); -extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size); -extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size); -extern "C" unsigned int Storage_Available (unsigned int Size); -extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname); -extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname); -extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname); -extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile); -extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s); -extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file); -extern "C" unsigned int FIO_IsNoError (FIO_File f); -extern "C" unsigned int FIO_IsActive (FIO_File f); -extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile); -extern "C" void FIO_Close (FIO_File f); -extern "C" unsigned int FIO_exists (void * fname, unsigned int flength); -extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength); -extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength); -extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile); -extern "C" void FIO_FlushBuffer (FIO_File f); -extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest); -extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high); -extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src); -extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high); -extern "C" void FIO_WriteChar (FIO_File f, char ch); -extern "C" unsigned int FIO_EOF (FIO_File f); -extern "C" unsigned int FIO_EOLN (FIO_File f); -extern "C" unsigned int FIO_WasEOLN (FIO_File f); -extern "C" char FIO_ReadChar (FIO_File f); -extern "C" void FIO_UnReadChar (FIO_File f, char ch); -extern "C" void FIO_WriteLine (FIO_File f); -extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high); -extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high); -extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c); -extern "C" unsigned int FIO_ReadCardinal (FIO_File f); -extern "C" int FIO_GetUnixFileDescriptor (FIO_File f); -extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos); -extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos); -extern "C" long int FIO_FindPosition (FIO_File f); -extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high); -extern "C" void * FIO_getFileName (FIO_File f); -extern "C" unsigned int FIO_getFileNameLength (FIO_File f); -extern "C" void FIO_FlushOutErr (void); - -/* - InitString - creates and returns a String type object. - Initial contents are, a. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high); - -/* - KillString - frees String, s, and its contents. - NIL is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s); - -/* - Fin - finishes with a string, it calls KillString with, s. - The purpose of the procedure is to provide a short cut - to calling KillString and then testing the return result. -*/ - -extern "C" void DynamicStrings_Fin (DynamicStrings_String s); - -/* - InitStringCharStar - initializes and returns a String to contain the C string. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a); - -/* - InitStringChar - initializes and returns a String to contain the single character, ch. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch); - -/* - Mark - marks String, s, ready for garbage collection. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s); - -/* - Length - returns the length of the String, s. -*/ - -extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s); - -/* - ConCat - returns String, a, after the contents of, b, have been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b); - -/* - ConCatChar - returns String, a, after character, ch, has been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch); - -/* - Assign - assigns the contents of, b, into, a. - String, a, is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b); - -/* - Dup - duplicate a String, s, returning the copy of s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s); - -/* - Add - returns a new String which contains the contents of a and b. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b); - -/* - Equal - returns TRUE if String, a, and, b, are equal. -*/ - -extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b); - -/* - EqualCharStar - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a); - -/* - EqualArray - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high); - -/* - Mult - returns a new string which is n concatenations of String, s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n); - -/* - Slice - returns a new string which contains the elements - low..high-1 - - strings start at element 0 - Slice(s, 0, 2) will return elements 0, 1 but not 2 - Slice(s, 1, 3) will return elements 1, 2 but not 3 - Slice(s, 2, 0) will return elements 2..max - Slice(s, 3, -1) will return elements 3..max-1 - Slice(s, 4, -2) will return elements 4..max-2 -*/ - -extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high); - -/* - Index - returns the indice of the first occurance of, ch, in - String, s. -1 is returned if, ch, does not exist. - The search starts at position, o. -*/ - -extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o); - -/* - RIndex - returns the indice of the last occurance of, ch, - in String, s. The search starts at position, o. - -1 is returned if, ch, is not found. -*/ - -extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o); - -/* - RemoveComment - assuming that, comment, is a comment delimiter - which indicates anything to its right is a comment - then strip off the comment and also any white space - on the remaining right hand side. - It leaves any white space on the left hand side alone. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment); - -/* - RemoveWhitePrefix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s); - -/* - RemoveWhitePostfix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s); - -/* - ToUpper - returns string, s, after it has had its lower case characters - replaced by upper case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s); - -/* - ToLower - returns string, s, after it has had its upper case characters - replaced by lower case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s); - -/* - CopyOut - copies string, s, to a. -*/ - -extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s); - -/* - char - returns the character, ch, at position, i, in String, s. -*/ - -extern "C" char DynamicStrings_char (DynamicStrings_String s, int i); - -/* - string - returns the C style char * of String, s. -*/ - -extern "C" void * DynamicStrings_string (DynamicStrings_String s); - -/* - InitStringDB - the debug version of InitString. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line); - -/* - InitStringCharStarDB - the debug version of InitStringCharStar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line); - -/* - InitStringCharDB - the debug version of InitStringChar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line); - -/* - MultDB - the debug version of MultDB. -*/ - -extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line); - -/* - DupDB - the debug version of Dup. -*/ - -extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line); - -/* - SliceDB - debug version of Slice. -*/ - -extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line); - -/* - PushAllocation - pushes the current allocation/deallocation lists. -*/ - -extern "C" void DynamicStrings_PushAllocation (void); - -/* - PopAllocation - test to see that all strings are deallocated since - the last push. Then it pops to the previous - allocation/deallocation lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" void DynamicStrings_PopAllocation (unsigned int halt); - -/* - PopAllocationExemption - test to see that all strings are deallocated, except - string, e, since the last push. - Then it pops to the previous allocation/deallocation - lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e); -extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower); -extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); -extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found); -extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); -extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower); -extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found); -extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); -extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); -extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower); -extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found); -extern "C" int StringConvert_stoi (DynamicStrings_String s); -extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign); -extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding); -extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s); -extern "C" int StringConvert_hstoi (DynamicStrings_String s); -extern "C" int StringConvert_ostoi (DynamicStrings_String s); -extern "C" int StringConvert_bstoi (DynamicStrings_String s); -extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s); -extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s); -extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s); -extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found); -extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth); -extern "C" double StringConvert_stor (DynamicStrings_String s); -extern "C" long double StringConvert_stolr (DynamicStrings_String s); -extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n); -extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n); -extern "C" DynamicStrings_String mcOptions_handleOptions (void); -extern "C" unsigned int mcOptions_getQuiet (void); -extern "C" unsigned int mcOptions_getVerbose (void); -extern "C" unsigned int mcOptions_getInternalDebugging (void); -extern "C" DynamicStrings_String mcOptions_getCppCommandLine (void); -extern "C" DynamicStrings_String mcOptions_getOutputFile (void); -extern "C" unsigned int mcOptions_getExtendedOpaque (void); -extern "C" void mcOptions_setDebugTopological (unsigned int value); -extern "C" unsigned int mcOptions_getDebugTopological (void); -extern "C" DynamicStrings_String mcOptions_getHPrefix (void); -extern "C" unsigned int mcOptions_getIgnoreFQ (void); -extern "C" unsigned int mcOptions_getGccConfigSystem (void); -extern "C" unsigned int mcOptions_getScaffoldDynamic (void); -extern "C" unsigned int mcOptions_getScaffoldMain (void); -extern "C" void mcOptions_writeGPLheader (FIO_File f); -extern "C" void mcOptions_setSuppressNoReturn (unsigned int value); -extern "C" unsigned int mcOptions_getSuppressNoReturn (void); -extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt); -extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high); -extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); -extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); -extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high); -extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s); -extern "C" ssize_t libc_write (int d, void * buf, size_t nbytes); -extern "C" ssize_t libc_read (int d, void * buf, size_t nbytes); -extern "C" int libc_system (void * a); -extern "C" void libc_abort (void) __attribute__ ((noreturn)); -extern "C" void * libc_malloc (size_t size); -extern "C" void libc_free (void * ptr); -extern "C" void * libc_realloc (void * ptr, size_t size); -extern "C" int libc_isatty (int fd); -extern "C" void libc_exit (int r) __attribute__ ((noreturn)); -extern "C" void * libc_getenv (void * s); -extern "C" int libc_putenv (void * s); -extern "C" int libc_getpid (void); -extern "C" int libc_dup (int d); -extern "C" int libc_close (int d); -extern "C" int libc_open (void * filename, int oflag, ...); -extern "C" int libc_creat (void * filename, unsigned int mode); -extern "C" long int libc_lseek (int fd, long int offset, int whence); -extern "C" void libc_perror (const char *string_, unsigned int _string_high); -extern "C" int libc_readv (int fd, void * v, int n); -extern "C" int libc_writev (int fd, void * v, int n); -extern "C" void * libc_getcwd (void * buf, size_t size); -extern "C" int libc_chown (void * filename, int uid, int gid); -extern "C" size_t libc_strlen (void * a); -extern "C" void * libc_strcpy (void * dest, void * src); -extern "C" void * libc_strncpy (void * dest, void * src, unsigned int n); -extern "C" int libc_unlink (void * file); -extern "C" void * libc_memcpy (void * dest, void * src, size_t size); -extern "C" void * libc_memset (void * s, int c, size_t size); -extern "C" void * libc_memmove (void * dest, void * src, size_t size); -extern "C" int libc_printf (const char *format_, unsigned int _format_high, ...); -extern "C" int libc_snprintf (void * dest, size_t size, const char *format_, unsigned int _format_high, ...); -extern "C" int libc_setenv (void * name, void * value, int overwrite); -extern "C" void libc_srand (int seed); -extern "C" int libc_rand (void); -extern "C" libc_time_t libc_time (void * a); -extern "C" void * libc_localtime (libc_time_t *t); -extern "C" int libc_ftime (libc_timeb *t); -extern "C" int libc_shutdown (int s, int how); -extern "C" int libc_rename (void * oldpath, void * newpath); -extern "C" int libc_setjmp (void * env); -extern "C" void libc_longjmp (void * env, int val); -extern "C" int libc_atexit (libc_exitP_C proc); -extern "C" void * libc_ttyname (int filedes); -extern "C" unsigned int libc_sleep (unsigned int seconds); -extern "C" int libc_execv (void * pathname, void * argv); -extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high); -extern "C" void mcMetaError_metaError2 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); -extern "C" void mcMetaError_metaError3 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); -extern "C" void mcMetaError_metaError4 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); -extern "C" void mcMetaError_metaErrors1 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high); -extern "C" void mcMetaError_metaErrors2 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); -extern "C" void mcMetaError_metaErrors3 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); -extern "C" void mcMetaError_metaErrors4 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); -extern "C" void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high); -extern "C" void mcMetaError_metaErrorT2 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); -extern "C" void mcMetaError_metaErrorT3 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); -extern "C" void mcMetaError_metaErrorT4 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); -extern "C" void mcMetaError_metaErrorsT1 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high); -extern "C" void mcMetaError_metaErrorsT2 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); -extern "C" void mcMetaError_metaErrorsT3 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); -extern "C" void mcMetaError_metaErrorsT4 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); -extern "C" void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high); -extern "C" void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); -extern "C" void mcMetaError_metaErrorString3 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); -extern "C" void mcMetaError_metaErrorString4 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); -extern "C" void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high); -extern "C" void mcMetaError_metaErrorStringT2 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); -extern "C" void mcMetaError_metaErrorStringT3 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); -extern "C" void mcMetaError_metaErrorStringT4 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); - -/* - internalError - displays an internal error message together with the compiler source - file and line number. - This function is not buffered and is used when the compiler is about - to give up. -*/ - -extern "C" void mcError_internalError (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line); - -/* - writeFormat0 - displays the source module and line together - with the encapsulated format string. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat0 (const char *a_, unsigned int _a_high); - -/* - writeFormat1 - displays the source module and line together - with the encapsulated format string. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - writeFormat2 - displays the module and line together with the encapsulated - format strings. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); - -/* - writeFormat3 - displays the module and line together with the encapsulated - format strings. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); - -/* - newError - creates and returns a new error handle. -*/ - -extern "C" mcError_error mcError_newError (unsigned int atTokenNo); - -/* - newWarning - creates and returns a new error handle suitable for a warning. - A warning will not stop compilation. -*/ - -extern "C" mcError_error mcError_newWarning (unsigned int atTokenNo); - -/* - chainError - creates and returns a new error handle, this new error - is associated with, e, and is chained onto the end of, e. - If, e, is NIL then the result to NewError is returned. -*/ - -extern "C" mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e); -extern "C" void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high); -extern "C" void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); -extern "C" void mcError_errorFormat2 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); -extern "C" void mcError_errorFormat3 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); -extern "C" void mcError_errorString (mcError_error e, DynamicStrings_String str); - -/* - errorStringAt - given an error string, s, it places this - string at token position, tok. - The string is consumed. -*/ - -extern "C" void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok); - -/* - errorStringAt2 - given an error string, s, it places this - string at token positions, tok1 and tok2, respectively. - The string is consumed. -*/ - -extern "C" void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2); - -/* - errorStringsAt2 - given error strings, s1, and, s2, it places these - strings at token positions, tok1 and tok2, respectively. - Both strings are consumed. -*/ - -extern "C" void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2); - -/* - warnStringAt - given an error string, s, it places this - string at token position, tok. - The string is consumed. -*/ - -extern "C" void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok); - -/* - warnStringAt2 - given an warning string, s, it places this - string at token positions, tok1 and tok2, respectively. - The string is consumed. -*/ - -extern "C" void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2); - -/* - warnStringsAt2 - given warning strings, s1, and, s2, it places these - strings at token positions, tok1 and tok2, respectively. - Both strings are consumed. -*/ - -extern "C" void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2); -extern "C" void mcError_warnFormat0 (const char *a_, unsigned int _a_high); - -/* - warnFormat1 - displays the source module and line together - with the encapsulated format string. - Used for simple warning messages tied to the current token. -*/ - -extern "C" void mcError_warnFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - flushErrors - switches the output channel to the error channel - and then writes out all errors. -*/ - -extern "C" void mcError_flushErrors (void); - -/* - flushWarnings - switches the output channel to the error channel - and then writes out all warnings. - If an error is present the compilation is terminated, - if warnings only were emitted then compilation will - continue. -*/ - -extern "C" void mcError_flushWarnings (void); - -/* - errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting. -*/ - -extern "C" void mcError_errorAbort0 (const char *a_, unsigned int _a_high); -extern "C" mcComment_commentDesc mcLexBuf_getProcedureComment (void); -extern "C" mcComment_commentDesc mcLexBuf_getBodyComment (void); -extern "C" mcComment_commentDesc mcLexBuf_getAfterComment (void); -extern "C" unsigned int mcLexBuf_openSource (DynamicStrings_String s); -extern "C" void mcLexBuf_closeSource (void); -extern "C" void mcLexBuf_reInitialize (void); -extern "C" void mcLexBuf_resetForNewPass (void); -extern "C" void mcLexBuf_getToken (void); -extern "C" void mcLexBuf_insertToken (mcReserved_toktype token); -extern "C" void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token); -extern "C" unsigned int mcLexBuf_getPreviousTokenLineNo (void); -extern "C" unsigned int mcLexBuf_getLineNo (void); -extern "C" unsigned int mcLexBuf_getTokenNo (void); -extern "C" unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth); -extern "C" unsigned int mcLexBuf_getColumnNo (void); -extern "C" unsigned int mcLexBuf_tokenToColumnNo (unsigned int tokenNo, unsigned int depth); -extern "C" DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth); -extern "C" DynamicStrings_String mcLexBuf_getFileName (void); -extern "C" void mcLexBuf_addTok (mcReserved_toktype t); -extern "C" void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s); -extern "C" void mcLexBuf_addTokInteger (mcReserved_toktype t, int i); -extern "C" void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com); -extern "C" void mcLexBuf_setFile (void * filename); -extern "C" void mcLexBuf_pushFile (void * filename); -extern "C" void mcLexBuf_popFile (void * filename); -extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high); -extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); -extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); -extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high); -extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high); -extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); -extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high); - -/* - initPretty - initialise a pretty print data structure. -*/ - -extern "C" mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l); - -/* - dupPretty - duplicate a pretty print data structure. -*/ - -extern "C" mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p); - -/* - killPretty - destroy a pretty print data structure. - Post condition: p is assigned to NIL. -*/ - -extern "C" void mcPretty_killPretty (mcPretty_pretty *p); - -/* - pushPretty - duplicate, p. Push, p, and return the duplicate. -*/ - -extern "C" mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p); - -/* - popPretty - pops the pretty object from the stack. -*/ - -extern "C" mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p); - -/* - getindent - returns the current indent value. -*/ - -extern "C" unsigned int mcPretty_getindent (mcPretty_pretty p); - -/* - setindent - sets the current indent to, n. -*/ - -extern "C" void mcPretty_setindent (mcPretty_pretty p, unsigned int n); - -/* - getcurpos - returns the current cursor position. -*/ - -extern "C" unsigned int mcPretty_getcurpos (mcPretty_pretty s); - -/* - getseekpos - returns the seek position. -*/ - -extern "C" unsigned int mcPretty_getseekpos (mcPretty_pretty s); - -/* - getcurline - returns the current line number. -*/ - -extern "C" unsigned int mcPretty_getcurline (mcPretty_pretty s); -extern "C" void mcPretty_setNeedSpace (mcPretty_pretty s); - -/* - noSpace - unset needsSpace. -*/ - -extern "C" void mcPretty_noSpace (mcPretty_pretty s); - -/* - print - print a string using, p. -*/ - -extern "C" void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high); - -/* - prints - print a string using, p. -*/ - -extern "C" void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s); - -/* - raw - print out string, s, without any translation of - escape sequences. -*/ - -extern "C" void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s); - -/* - InitIndex - creates and returns an Index. -*/ - -extern "C" Indexing_Index Indexing_InitIndex (unsigned int low); - -/* - KillIndex - returns Index to free storage. -*/ - -extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i); - -/* - DebugIndex - turns on debugging within an index. -*/ - -extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i); - -/* - InBounds - returns TRUE if indice, n, is within the bounds - of the dynamic array. -*/ - -extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n); - -/* - HighIndice - returns the last legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_HighIndice (Indexing_Index i); - -/* - LowIndice - returns the first legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_LowIndice (Indexing_Index i); - -/* - PutIndice - places, a, into the dynamic array at position i[n] -*/ - -extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a); - -/* - GetIndice - retrieves, element i[n] from the dynamic array. -*/ - -extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n); - -/* - IsIndiceInIndex - returns TRUE if, a, is in the index, i. -*/ - -extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a); - -/* - RemoveIndiceFromIndex - removes, a, from Index, i. -*/ - -extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a); - -/* - DeleteIndice - delete i[j] from the array. -*/ - -extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j); - -/* - IncludeIndiceIntoIndex - if the indice is not in the index, then - add it at the end. -*/ - -extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a); - -/* - ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j]) -*/ - -extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p); - -/* - initList - creates a new alist, l. -*/ - -extern "C" alists_alist alists_initList (void); - -/* - killList - deletes the complete alist, l. -*/ - -extern "C" void alists_killList (alists_alist *l); - -/* - putItemIntoList - places an ADDRESS, c, into alist, l. -*/ - -extern "C" void alists_putItemIntoList (alists_alist l, void * c); - -/* - getItemFromList - retrieves the nth WORD from alist, l. -*/ - -extern "C" void * alists_getItemFromList (alists_alist l, unsigned int n); - -/* - getIndexOfList - returns the index for WORD, c, in alist, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int alists_getIndexOfList (alists_alist l, void * c); - -/* - noOfItemsInList - returns the number of items in alist, l. -*/ - -extern "C" unsigned int alists_noOfItemsInList (alists_alist l); - -/* - includeItemIntoList - adds an ADDRESS, c, into a alist providing - the value does not already exist. -*/ - -extern "C" void alists_includeItemIntoList (alists_alist l, void * c); - -/* - removeItemFromList - removes a ADDRESS, c, from a alist. - It assumes that this value only appears once. -*/ - -extern "C" void alists_removeItemFromList (alists_alist l, void * c); - -/* - isItemInList - returns true if a ADDRESS, c, was found in alist, l. -*/ - -extern "C" unsigned int alists_isItemInList (alists_alist l, void * c); - -/* - foreachItemInListDo - calls procedure, P, foreach item in alist, l. -*/ - -extern "C" void alists_foreachItemInListDo (alists_alist l, alists_performOperation p); - -/* - duplicateList - returns a duplicate alist derived from, l. -*/ - -extern "C" alists_alist alists_duplicateList (alists_alist l); - -/* - initList - creates a new wlist, l. -*/ - -extern "C" wlists_wlist wlists_initList (void); - -/* - killList - deletes the complete wlist, l. -*/ - -extern "C" void wlists_killList (wlists_wlist *l); - -/* - putItemIntoList - places an WORD, c, into wlist, l. -*/ - -extern "C" void wlists_putItemIntoList (wlists_wlist l, unsigned int c); - -/* - getItemFromList - retrieves the nth WORD from wlist, l. -*/ - -extern "C" unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n); - -/* - getIndexOfList - returns the index for WORD, c, in wlist, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c); - -/* - noOfItemsInList - returns the number of items in wlist, l. -*/ - -extern "C" unsigned int wlists_noOfItemsInList (wlists_wlist l); - -/* - includeItemIntoList - adds an WORD, c, into a wlist providing - the value does not already exist. -*/ - -extern "C" void wlists_includeItemIntoList (wlists_wlist l, unsigned int c); - -/* - removeItemFromList - removes a WORD, c, from a wlist. - It assumes that this value only appears once. -*/ - -extern "C" void wlists_removeItemFromList (wlists_wlist l, unsigned int c); - -/* - replaceItemInList - replace the nth WORD in wlist, l. - The first item in a wlists is at index, 1. - If the index, n, is out of range nothing is changed. -*/ - -extern "C" void wlists_replaceItemInList (wlists_wlist l, unsigned int n, unsigned int w); - -/* - isItemInList - returns true if a WORD, c, was found in wlist, l. -*/ - -extern "C" unsigned int wlists_isItemInList (wlists_wlist l, unsigned int c); - -/* - foreachItemInListDo - calls procedure, P, foreach item in wlist, l. -*/ - -extern "C" void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p); - -/* - duplicateList - returns a duplicate wlist derived from, l. -*/ - -extern "C" wlists_wlist wlists_duplicateList (wlists_wlist l); -extern "C" void keyc_useUnistd (void); -extern "C" void keyc_useThrow (void); -extern "C" void keyc_useStorage (void); -extern "C" void keyc_useFree (void); -extern "C" void keyc_useMalloc (void); -extern "C" void keyc_useProc (void); -extern "C" void keyc_useTrue (void); -extern "C" void keyc_useFalse (void); -extern "C" void keyc_useNull (void); -extern "C" void keyc_useMemcpy (void); -extern "C" void keyc_useIntMin (void); -extern "C" void keyc_useUIntMin (void); -extern "C" void keyc_useLongMin (void); -extern "C" void keyc_useULongMin (void); -extern "C" void keyc_useCharMin (void); -extern "C" void keyc_useUCharMin (void); -extern "C" void keyc_useIntMax (void); -extern "C" void keyc_useUIntMax (void); -extern "C" void keyc_useLongMax (void); -extern "C" void keyc_useULongMax (void); -extern "C" void keyc_useCharMax (void); -extern "C" void keyc_useUCharMax (void); -extern "C" void keyc_useSize_t (void); -extern "C" void keyc_useSSize_t (void); -extern "C" void keyc_useLabs (void); -extern "C" void keyc_useAbs (void); -extern "C" void keyc_useFabs (void); -extern "C" void keyc_useFabsl (void); -extern "C" void keyc_useException (void); -extern "C" void keyc_useComplex (void); -extern "C" void keyc_useM2RTS (void); -extern "C" void keyc_useStrlen (void); -extern "C" void keyc_useCtype (void); -extern "C" void keyc_genDefs (mcPretty_pretty p); -extern "C" void keyc_genConfigSystem (mcPretty_pretty p); -extern "C" void keyc_enterScope (decl_node n); -extern "C" void keyc_leaveScope (decl_node n); -extern "C" DynamicStrings_String keyc_cname (nameKey_Name n, unsigned int scopes); -extern "C" nameKey_Name keyc_cnamen (nameKey_Name n, unsigned int scopes); -extern "C" void keyc_cp (void); -extern "C" FIO_File mcStream_openFrag (unsigned int id); -extern "C" void mcStream_setDest (FIO_File f); -extern "C" FIO_File mcStream_combine (void); -extern "C" void mcStream_removeFiles (void); -extern "C" void StrIO_WriteLn (void); -extern "C" void StrIO_ReadString (char *a, unsigned int _a_high); -extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high); -extern "C" void NumberIO_ReadCard (unsigned int *x); -extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n); -extern "C" void NumberIO_ReadHex (unsigned int *x); -extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n); -extern "C" void NumberIO_ReadInt (int *x); -extern "C" void NumberIO_WriteInt (int x, unsigned int n); -extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_ReadOct (unsigned int *x); -extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n); -extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_ReadBin (unsigned int *x); -extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n); -extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high); -extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high); -extern "C" void Assertion_Assert (unsigned int Condition); -extern "C" void StdIO_Read (char *ch); -extern "C" void StdIO_Write (char ch); -extern "C" void StdIO_PushOutput (StdIO_ProcWrite p); -extern "C" void StdIO_PopOutput (void); -extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void); -extern "C" void StdIO_PushInput (StdIO_ProcRead p); -extern "C" void StdIO_PopInput (void); -extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void); -extern "C" void mcPrintf_printf0 (const char *a_, unsigned int _a_high); -extern "C" void mcPrintf_printf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); -extern "C" void mcPrintf_printf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); -extern "C" void mcPrintf_printf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); -extern "C" void mcPrintf_printf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high); -extern "C" void mcPrintf_fprintf0 (FIO_File file, const char *a_, unsigned int _a_high); -extern "C" void mcPrintf_fprintf1 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); -extern "C" void mcPrintf_fprintf2 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); -extern "C" void mcPrintf_fprintf3 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); -extern "C" void mcPrintf_fprintf4 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high); - -/* - newNode - create and return a new node of kind k. -*/ - -static decl_node newNode (decl_nodeT k); - -/* - disposeNode - dispose node, n. -*/ - -static void disposeNode (decl_node *n); - -/* - isLocal - returns TRUE if symbol, n, is locally declared in a procedure. -*/ - -static unsigned int isLocal (decl_node n); - -/* - importEnumFields - if, n, is an enumeration type import the all fields into module, m. -*/ - -static void importEnumFields (decl_node m, decl_node n); - -/* - isComplex - returns TRUE if, n, is the complex type. -*/ - -static unsigned int isComplex (decl_node n); - -/* - isLongComplex - returns TRUE if, n, is the longcomplex type. -*/ - -static unsigned int isLongComplex (decl_node n); - -/* - isShortComplex - returns TRUE if, n, is the shortcomplex type. -*/ - -static unsigned int isShortComplex (decl_node n); - -/* - isAProcType - returns TRUE if, n, is a proctype or proc node. -*/ - -static unsigned int isAProcType (decl_node n); - -/* - initFixupInfo - initialize the fixupInfo record. -*/ - -static decl_fixupInfo initFixupInfo (void); - -/* - makeDef - returns a definition module node named, n. -*/ - -static decl_node makeDef (nameKey_Name n); - -/* - makeImp - returns an implementation module node named, n. -*/ - -static decl_node makeImp (nameKey_Name n); - -/* - makeModule - returns a module node named, n. -*/ - -static decl_node makeModule (nameKey_Name n); - -/* - isDefForC - returns TRUE if the definition module was defined FOR "C". -*/ - -static unsigned int isDefForC (decl_node n); - -/* - initDecls - initialize the decls, scopeT. -*/ - -static void initDecls (decl_scopeT *decls); - -/* - addTo - adds node, d, to scope decls and returns, d. - It stores, d, in the symbols tree associated with decls. -*/ - -static decl_node addTo (decl_scopeT *decls, decl_node d); - -/* - export - export node, n, from definition module, d. -*/ - -static void export_ (decl_node d, decl_node n); - -/* - addToScope - adds node, n, to the current scope and returns, n. -*/ - -static decl_node addToScope (decl_node n); - -/* - addModuleToScope - adds module, i, to module, m, scope. -*/ - -static void addModuleToScope (decl_node m, decl_node i); - -/* - completedEnum - assign boolean enumsComplete to TRUE if a definition, - implementation or module symbol. -*/ - -static void completedEnum (decl_node n); - -/* - setUnary - sets a unary node to contain, arg, a, and type, t. -*/ - -static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t); - -/* - putVarBool - assigns the four booleans associated with a variable. -*/ - -static void putVarBool (decl_node v, unsigned int init, unsigned int param, unsigned int isvar, unsigned int isused); - -/* - checkPtr - in C++ we need to create a typedef for a pointer - in case we need to use reinterpret_cast. -*/ - -static decl_node checkPtr (decl_node n); - -/* - isVarDecl - returns TRUE if, n, is a vardecl node. -*/ - -static unsigned int isVarDecl (decl_node n); - -/* - makeVariablesFromParameters - creates variables which are really parameters. -*/ - -static void makeVariablesFromParameters (decl_node proc, decl_node id, decl_node type, unsigned int isvar, unsigned int isused); - -/* - addProcedureToScope - add a procedure name n and node d to the - current scope. -*/ - -static decl_node addProcedureToScope (decl_node d, nameKey_Name n); - -/* - putProcTypeReturn - sets the return type of, proc, to, type. -*/ - -static void putProcTypeReturn (decl_node proc, decl_node type); - -/* - putProcTypeOptReturn - sets, proc, to have an optional return type. -*/ - -static void putProcTypeOptReturn (decl_node proc); - -/* - makeOptParameter - creates and returns an optarg. -*/ - -static decl_node makeOptParameter (decl_node l, decl_node type, decl_node init); - -/* - setwatch - assign the globalNode to n. -*/ - -static unsigned int setwatch (decl_node n); - -/* - runwatch - set the globalNode to an identlist. -*/ - -static unsigned int runwatch (void); - -/* - isIdentList - returns TRUE if, n, is an identlist. -*/ - -static unsigned int isIdentList (decl_node n); - -/* - identListLen - returns the length of identlist. -*/ - -static unsigned int identListLen (decl_node n); - -/* - checkParameters - placeholder for future parameter checking. -*/ - -static void checkParameters (decl_node p, decl_node i, decl_node type, unsigned int isvar, unsigned int isused); - -/* - checkMakeVariables - create shadow local variables for parameters providing that - procedure n has not already been built and we are compiling - a module or an implementation module. -*/ - -static void checkMakeVariables (decl_node n, decl_node i, decl_node type, unsigned int isvar, unsigned int isused); - -/* - makeVarientField - create a varient field within varient, v, - The new varient field is returned. -*/ - -static decl_node makeVarientField (decl_node v, decl_node p); - -/* - putFieldVarient - places the field varient, f, as a brother to, the - varient symbol, v, and also tells, f, that its varient - parent is, v. -*/ - -static void putFieldVarient (decl_node f, decl_node v); - -/* - putFieldRecord - create a new recordfield and place it into record r. - The new field has a tagname and type and can have a - variant field v. -*/ - -static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type, decl_node v); - -/* - ensureOrder - ensures that, a, and, b, exist in, i, and also - ensure that, a, is before, b. -*/ - -static void ensureOrder (Indexing_Index i, decl_node a, decl_node b); - -/* - putVarientTag - places tag into variant v. -*/ - -static void putVarientTag (decl_node v, decl_node tag); - -/* - getParent - returns the parent field of recordfield or varientfield symbol, n. -*/ - -static decl_node getParent (decl_node n); - -/* - getRecord - returns the record associated with node, n. - (Parental record). -*/ - -static decl_node getRecord (decl_node n); - -/* - isConstExp - return TRUE if the node kind is a constexp. -*/ - -static unsigned int isConstExp (decl_node c); - -/* - addEnumToModule - adds enumeration type, e, into the list of enums - in module, m. -*/ - -static void addEnumToModule (decl_node m, decl_node e); - -/* - getNextFixup - return the next fixup from from f. -*/ - -static decl_node getNextFixup (decl_fixupInfo *f); - -/* - doMakeEnum - create an enumeration type and add it to the current module. -*/ - -static decl_node doMakeEnum (void); - -/* - doMakeEnumField - create an enumeration field name and add it to enumeration e. - Return the new field. -*/ - -static decl_node doMakeEnumField (decl_node e, nameKey_Name n); - -/* - getExpList - returns the, n, th argument in an explist. -*/ - -static decl_node getExpList (decl_node p, unsigned int n); - -/* - expListLen - returns the length of explist, p. -*/ - -static unsigned int expListLen (decl_node p); - -/* - getConstExpComplete - gets the field from the def or imp or module, n. -*/ - -static unsigned int getConstExpComplete (decl_node n); - -/* - addConstToModule - adds const exp, e, into the list of constant - expressions in module, m. -*/ - -static void addConstToModule (decl_node m, decl_node e); - -/* - doMakeConstExp - create a constexp node and add it to the current module. -*/ - -static decl_node doMakeConstExp (void); - -/* - isAnyType - return TRUE if node n is any type kind. -*/ - -static unsigned int isAnyType (decl_node n); - -/* - makeVal - creates a VAL (type, expression) node. -*/ - -static decl_node makeVal (decl_node params); - -/* - makeCast - creates a cast node TYPENAME (expr). -*/ - -static decl_node makeCast (decl_node c, decl_node p); -static decl_node makeIntrinsicProc (decl_nodeT k, unsigned int noArgs, decl_node p); - -/* - makeIntrinsicUnaryType - create an intrisic unary type. -*/ - -static decl_node makeIntrinsicUnaryType (decl_nodeT k, decl_node paramList, decl_node returnType); - -/* - makeIntrinsicBinaryType - create an intrisic binary type. -*/ - -static decl_node makeIntrinsicBinaryType (decl_nodeT k, decl_node paramList, decl_node returnType); - -/* - checkIntrinsic - checks to see if the function call to, c, with - parameter list, n, is really an intrinic. If it - is an intrinic then an intrinic node is created - and returned. Otherwise NIL is returned. -*/ - -static decl_node checkIntrinsic (decl_node c, decl_node n); - -/* - checkCHeaders - check to see if the function is a C system function and - requires a header file included. -*/ - -static void checkCHeaders (decl_node c); - -/* - isFuncCall - returns TRUE if, n, is a function/procedure call. -*/ - -static unsigned int isFuncCall (decl_node n); - -/* - putTypeInternal - marks type, des, as being an internally generated type. -*/ - -static void putTypeInternal (decl_node des); - -/* - isTypeInternal - returns TRUE if type, n, is internal. -*/ - -static unsigned int isTypeInternal (decl_node n); - -/* - lookupBase - return node named n from the base symbol scope. -*/ - -static decl_node lookupBase (nameKey_Name n); - -/* - dumpScopes - display the names of all the scopes stacked. -*/ - -static void dumpScopes (void); - -/* - out0 - write string a to StdOut. -*/ - -static void out0 (const char *a_, unsigned int _a_high); - -/* - out1 - write string a to StdOut using format specifier a. -*/ - -static void out1 (const char *a_, unsigned int _a_high, decl_node s); - -/* - out2 - write string a to StdOut using format specifier a. -*/ - -static void out2 (const char *a_, unsigned int _a_high, unsigned int c, decl_node s); - -/* - out3 - write string a to StdOut using format specifier a. -*/ - -static void out3 (const char *a_, unsigned int _a_high, unsigned int l, nameKey_Name n, decl_node s); - -/* - isUnary - returns TRUE if, n, is an unary node. -*/ - -static unsigned int isUnary (decl_node n); - -/* - isBinary - returns TRUE if, n, is an binary node. -*/ - -static unsigned int isBinary (decl_node n); - -/* - makeUnary - create a unary expression node with, e, as the argument - and res as the return type. -*/ - -static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res); - -/* - isLeafString - returns TRUE if n is a leaf node which is a string constant. -*/ - -static unsigned int isLeafString (decl_node n); - -/* - getLiteralStringContents - return the contents of a literal node as a string. -*/ - -static DynamicStrings_String getLiteralStringContents (decl_node n); - -/* - getStringContents - return the string contents of a constant, literal, - string or a constexp node. -*/ - -static DynamicStrings_String getStringContents (decl_node n); - -/* - addNames - -*/ - -static nameKey_Name addNames (decl_node a, decl_node b); - -/* - resolveString - -*/ - -static decl_node resolveString (decl_node n); - -/* - foldBinary - -*/ - -static decl_node foldBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res); - -/* - makeBinary - create a binary node with left/right/result type: l, r and resultType. -*/ - -static decl_node makeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node resultType); - -/* - doMakeBinary - returns a binary node containing left/right/result values - l, r, res, with a node operator, k. -*/ - -static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res); - -/* - doMakeComponentRef - -*/ - -static decl_node doMakeComponentRef (decl_node rec, decl_node field); - -/* - isComponentRef - -*/ - -static unsigned int isComponentRef (decl_node n); - -/* - isArrayRef - returns TRUE if the node was an arrayref. -*/ - -static unsigned int isArrayRef (decl_node n); - -/* - isDeref - returns TRUE if, n, is a deref node. -*/ - -static unsigned int isDeref (decl_node n); - -/* - makeBase - create a base type or constant. - It only supports the base types and constants - enumerated below. -*/ - -static decl_node makeBase (decl_nodeT k); - -/* - isOrdinal - returns TRUE if, n, is an ordinal type. -*/ - -static unsigned int isOrdinal (decl_node n); - -/* - mixTypes - -*/ - -static decl_node mixTypes (decl_node a, decl_node b); - -/* - doSetExprType - -*/ - -static decl_node doSetExprType (decl_node *t, decl_node n); - -/* - getMaxMinType - -*/ - -static decl_node getMaxMinType (decl_node n); - -/* - doGetFuncType - -*/ - -static decl_node doGetFuncType (decl_node n); - -/* - doGetExprType - works out the type which is associated with node, n. -*/ - -static decl_node doGetExprType (decl_node n); - -/* - getExprType - return the expression type. -*/ - -static decl_node getExprType (decl_node n); - -/* - openOutput - -*/ - -static void openOutput (void); - -/* - closeOutput - -*/ - -static void closeOutput (void); - -/* - write - outputs a single char, ch. -*/ - -static void write_ (char ch); - -/* - writeln - -*/ - -static void writeln (void); - -/* - doIncludeC - include header file for definition module, n. -*/ - -static void doIncludeC (decl_node n); - -/* - getSymScope - returns the scope where node, n, was declared. -*/ - -static decl_node getSymScope (decl_node n); - -/* - isQualifiedForced - should the node be written with a module prefix? -*/ - -static unsigned int isQualifiedForced (decl_node n); - -/* - getFQstring - -*/ - -static DynamicStrings_String getFQstring (decl_node n); - -/* - getFQDstring - -*/ - -static DynamicStrings_String getFQDstring (decl_node n, unsigned int scopes); - -/* - getString - returns the name as a string. -*/ - -static DynamicStrings_String getString (decl_node n); - -/* - doNone - call HALT. -*/ - -static void doNone (decl_node n); - -/* - doNothing - does nothing! -*/ - -static void doNothing (decl_node n); - -/* - doConstC - -*/ - -static void doConstC (decl_node n); - -/* - needsParen - returns TRUE if expression, n, needs to be enclosed in (). -*/ - -static unsigned int needsParen (decl_node n); - -/* - doUnary - -*/ - -static void doUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr, decl_node type, unsigned int l, unsigned int r); - -/* - doSetSub - perform l & (~ r) -*/ - -static void doSetSub (mcPretty_pretty p, decl_node left, decl_node right); - -/* - doPolyBinary - -*/ - -static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl_node right, unsigned int l, unsigned int r); - -/* - doBinary - -*/ - -static void doBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r, unsigned int unpackProc); - -/* - doPostUnary - -*/ - -static void doPostUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr); - -/* - doDeRefC - -*/ - -static void doDeRefC (mcPretty_pretty p, decl_node expr); - -/* - doGetLastOp - returns, a, if b is a terminal otherwise walk right. -*/ - -static decl_node doGetLastOp (decl_node a, decl_node b); - -/* - doComponentRefC - -*/ - -static void doComponentRefC (mcPretty_pretty p, decl_node l, decl_node r); - -/* - doPointerRefC - -*/ - -static void doPointerRefC (mcPretty_pretty p, decl_node l, decl_node r); - -/* - doPreBinary - -*/ - -static void doPreBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r); - -/* - doConstExpr - -*/ - -static void doConstExpr (mcPretty_pretty p, decl_node n); - -/* - doEnumerationField - -*/ - -static void doEnumerationField (mcPretty_pretty p, decl_node n); - -/* - isZero - returns TRUE if node, n, is zero. -*/ - -static unsigned int isZero (decl_node n); - -/* - doArrayRef - -*/ - -static void doArrayRef (mcPretty_pretty p, decl_node n); - -/* - doProcedure - -*/ - -static void doProcedure (mcPretty_pretty p, decl_node n); - -/* - doRecordfield - -*/ - -static void doRecordfield (mcPretty_pretty p, decl_node n); - -/* - doCastC - -*/ - -static void doCastC (mcPretty_pretty p, decl_node t, decl_node e); - -/* - doSetValueC - -*/ - -static void doSetValueC (mcPretty_pretty p, decl_node n); - -/* - getSetLow - returns the low value of the set type from - expression, n. -*/ - -static decl_node getSetLow (decl_node n); - -/* - doInC - performs (((1 << (l)) & (r)) != 0) -*/ - -static void doInC (mcPretty_pretty p, decl_node l, decl_node r); - -/* - doThrowC - -*/ - -static void doThrowC (mcPretty_pretty p, decl_node n); - -/* - doUnreachableC - -*/ - -static void doUnreachableC (mcPretty_pretty p, decl_node n); - -/* - outNull - -*/ - -static void outNull (mcPretty_pretty p); - -/* - outTrue - -*/ - -static void outTrue (mcPretty_pretty p); - -/* - outFalse - -*/ - -static void outFalse (mcPretty_pretty p); - -/* - doExprC - -*/ - -static void doExprC (mcPretty_pretty p, decl_node n); - -/* - doExprCup - -*/ - -static void doExprCup (mcPretty_pretty p, decl_node n, unsigned int unpackProc); - -/* - doExprM2 - -*/ - -static void doExprM2 (mcPretty_pretty p, decl_node n); - -/* - doVar - -*/ - -static void doVar (mcPretty_pretty p, decl_node n); - -/* - doLiteralC - -*/ - -static void doLiteralC (mcPretty_pretty p, decl_node n); - -/* - doLiteral - -*/ - -static void doLiteral (mcPretty_pretty p, decl_node n); - -/* - isString - returns TRUE if node, n, is a string. -*/ - -static unsigned int isString (decl_node n); - -/* - doString - -*/ - -static void doString (mcPretty_pretty p, decl_node n); - -/* - replaceChar - replace every occurance of, ch, by, a and return modified string, s. -*/ - -static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, const char *a_, unsigned int _a_high); - -/* - toCstring - translates string, n, into a C string - and returns the new String. -*/ - -static DynamicStrings_String toCstring (nameKey_Name n); - -/* - toCchar - -*/ - -static DynamicStrings_String toCchar (nameKey_Name n); - -/* - countChar - -*/ - -static unsigned int countChar (DynamicStrings_String s, char ch); - -/* - lenCstring - -*/ - -static unsigned int lenCstring (DynamicStrings_String s); - -/* - outCstring - -*/ - -static void outCstring (mcPretty_pretty p, decl_node s, unsigned int aString); - -/* - doStringC - -*/ - -static void doStringC (mcPretty_pretty p, decl_node n); - -/* - isPunct - -*/ - -static unsigned int isPunct (char ch); - -/* - isWhite - -*/ - -static unsigned int isWhite (char ch); - -/* - outText - -*/ - -static void outText (mcPretty_pretty p, const char *a_, unsigned int _a_high); - -/* - outRawS - -*/ - -static void outRawS (mcPretty_pretty p, DynamicStrings_String s); - -/* - outKm2 - -*/ - -static mcPretty_pretty outKm2 (mcPretty_pretty p, const char *a_, unsigned int _a_high); - -/* - outKc - -*/ - -static mcPretty_pretty outKc (mcPretty_pretty p, const char *a_, unsigned int _a_high); - -/* - outTextS - -*/ - -static void outTextS (mcPretty_pretty p, DynamicStrings_String s); - -/* - outCard - -*/ - -static void outCard (mcPretty_pretty p, unsigned int c); - -/* - outTextN - -*/ - -static void outTextN (mcPretty_pretty p, nameKey_Name n); - -/* - doTypeAliasC - -*/ - -static void doTypeAliasC (mcPretty_pretty p, decl_node n, decl_node *m); - -/* - doEnumerationC - -*/ - -static void doEnumerationC (mcPretty_pretty p, decl_node n); - -/* - doNamesC - -*/ - -static void doNamesC (mcPretty_pretty p, nameKey_Name n); - -/* - doNameC - -*/ - -static void doNameC (mcPretty_pretty p, decl_node n); - -/* - initCname - -*/ - -static void initCname (decl_cnameT *c); - -/* - doCname - -*/ - -static nameKey_Name doCname (nameKey_Name n, decl_cnameT *c, unsigned int scopes); - -/* - getDName - -*/ - -static nameKey_Name getDName (decl_node n, unsigned int scopes); - -/* - doDNameC - -*/ - -static void doDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes); - -/* - doFQDNameC - -*/ - -static void doFQDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes); - -/* - doFQNameC - -*/ - -static void doFQNameC (mcPretty_pretty p, decl_node n); - -/* - doNameM2 - -*/ - -static void doNameM2 (mcPretty_pretty p, decl_node n); - -/* - doUsed - -*/ - -static void doUsed (mcPretty_pretty p, unsigned int used); - -/* - doHighC - -*/ - -static void doHighC (mcPretty_pretty p, decl_node a, nameKey_Name n, unsigned int isused); - -/* - doParamConstCast - -*/ - -static void doParamConstCast (mcPretty_pretty p, decl_node n); - -/* - getParameterVariable - returns the variable which shadows the parameter - named, m, in parameter block, n. -*/ - -static decl_node getParameterVariable (decl_node n, nameKey_Name m); - -/* - doParamTypeEmit - emit parameter type for C/C++. It checks to see if the - parameter type is a procedure type and if it were declared - in a definition module for "C" and if so it uses the "C" - definition for a procedure type, rather than the mc - C++ version. -*/ - -static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype); - -/* - doParamC - emit parameter for C/C++. -*/ - -static void doParamC (mcPretty_pretty p, decl_node n); - -/* - doVarParamC - emit a VAR parameter for C/C++. -*/ - -static void doVarParamC (mcPretty_pretty p, decl_node n); - -/* - doOptargC - -*/ - -static void doOptargC (mcPretty_pretty p, decl_node n); - -/* - doParameterC - -*/ - -static void doParameterC (mcPretty_pretty p, decl_node n); - -/* - doProcTypeC - -*/ - -static void doProcTypeC (mcPretty_pretty p, decl_node t, decl_node n); - -/* - doTypesC - -*/ - -static void doTypesC (decl_node n); - -/* - doCompletePartialC - -*/ - -static void doCompletePartialC (decl_node n); - -/* - doCompletePartialRecord - -*/ - -static void doCompletePartialRecord (mcPretty_pretty p, decl_node t, decl_node r); - -/* - doCompletePartialArray - -*/ - -static void doCompletePartialArray (mcPretty_pretty p, decl_node t, decl_node r); - -/* - lookupConst - -*/ - -static decl_node lookupConst (decl_node type, nameKey_Name n); - -/* - doMin - -*/ - -static decl_node doMin (decl_node n); - -/* - doMax - -*/ - -static decl_node doMax (decl_node n); - -/* - getMax - -*/ - -static decl_node getMax (decl_node n); - -/* - getMin - -*/ - -static decl_node getMin (decl_node n); - -/* - doSubtractC - -*/ - -static void doSubtractC (mcPretty_pretty p, decl_node s); - -/* - doSubrC - -*/ - -static void doSubrC (mcPretty_pretty p, decl_node s); - -/* - doCompletePartialProcType - -*/ - -static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node n); - -/* - isBase - -*/ - -static unsigned int isBase (decl_node n); - -/* - doBaseC - -*/ - -static void doBaseC (mcPretty_pretty p, decl_node n); - -/* - isSystem - -*/ - -static unsigned int isSystem (decl_node n); - -/* - doSystemC - -*/ - -static void doSystemC (mcPretty_pretty p, decl_node n); - -/* - doArrayC - -*/ - -static void doArrayC (mcPretty_pretty p, decl_node n); - -/* - doPointerC - -*/ - -static void doPointerC (mcPretty_pretty p, decl_node n, decl_node *m); - -/* - doRecordFieldC - -*/ - -static void doRecordFieldC (mcPretty_pretty p, decl_node f); - -/* - doVarientFieldC - -*/ - -static void doVarientFieldC (mcPretty_pretty p, decl_node n); - -/* - doVarientC - -*/ - -static void doVarientC (mcPretty_pretty p, decl_node n); - -/* - doRecordC - -*/ - -static void doRecordC (mcPretty_pretty p, decl_node n, decl_node *m); - -/* - isBitset - -*/ - -static unsigned int isBitset (decl_node n); - -/* - isNegative - returns TRUE if expression, n, is negative. -*/ - -static unsigned int isNegative (decl_node n); - -/* - doSubrangeC - -*/ - -static void doSubrangeC (mcPretty_pretty p, decl_node n); - -/* - doSetC - generates a C type which holds the set. - Currently we only support sets of size WORD. -*/ - -static void doSetC (mcPretty_pretty p, decl_node n); - -/* - doTypeC - -*/ - -static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m); - -/* - doArrayNameC - it displays the array declaration (it might be an unbounded). -*/ - -static void doArrayNameC (mcPretty_pretty p, decl_node n); - -/* - doRecordNameC - emit the C/C++ record name "_r". -*/ - -static void doRecordNameC (mcPretty_pretty p, decl_node n); - -/* - doPointerNameC - emit the C/C++ pointer type *. -*/ - -static void doPointerNameC (mcPretty_pretty p, decl_node n); - -/* - doTypeNameC - -*/ - -static void doTypeNameC (mcPretty_pretty p, decl_node n); - -/* - isExternal - returns TRUE if symbol, n, was declared in another module. -*/ - -static unsigned int isExternal (decl_node n); - -/* - doVarC - -*/ - -static void doVarC (decl_node n); - -/* - doExternCP - -*/ - -static void doExternCP (mcPretty_pretty p); - -/* - doProcedureCommentText - -*/ - -static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s); - -/* - doProcedureComment - -*/ - -static void doProcedureComment (mcPretty_pretty p, DynamicStrings_String s); - -/* - doProcedureHeadingC - -*/ - -static void doProcedureHeadingC (decl_node n, unsigned int prototype); - -/* - checkDeclareUnboundedParamCopyC - -*/ - -static unsigned int checkDeclareUnboundedParamCopyC (mcPretty_pretty p, decl_node n); - -/* - checkUnboundedParamCopyC - -*/ - -static void checkUnboundedParamCopyC (mcPretty_pretty p, decl_node n); - -/* - doUnboundedParamCopyC - -*/ - -static void doUnboundedParamCopyC (mcPretty_pretty p, decl_node n); - -/* - doPrototypeC - -*/ - -static void doPrototypeC (decl_node n); - -/* - addTodo - adds, n, to the todo list. -*/ - -static void addTodo (decl_node n); - -/* - addVariablesTodo - -*/ - -static void addVariablesTodo (decl_node n); - -/* - addTypesTodo - -*/ - -static void addTypesTodo (decl_node n); - -/* - tempName - -*/ - -static DynamicStrings_String tempName (void); - -/* - makeIntermediateType - -*/ - -static decl_node makeIntermediateType (DynamicStrings_String s, decl_node p); - -/* - simplifyType - -*/ - -static void simplifyType (alists_alist l, decl_node *p); - -/* - simplifyVar - -*/ - -static void simplifyVar (alists_alist l, decl_node n); - -/* - simplifyRecord - -*/ - -static void simplifyRecord (alists_alist l, decl_node n); - -/* - simplifyVarient - -*/ - -static void simplifyVarient (alists_alist l, decl_node n); - -/* - simplifyVarientField - -*/ - -static void simplifyVarientField (alists_alist l, decl_node n); - -/* - doSimplifyNode - -*/ - -static void doSimplifyNode (alists_alist l, decl_node n); - -/* - simplifyNode - -*/ - -static void simplifyNode (alists_alist l, decl_node n); - -/* - doSimplify - -*/ - -static void doSimplify (decl_node n); - -/* - simplifyTypes - -*/ - -static void simplifyTypes (decl_scopeT s); - -/* - outDeclsDefC - -*/ - -static void outDeclsDefC (mcPretty_pretty p, decl_node n); - -/* - includeConstType - -*/ - -static void includeConstType (decl_scopeT s); - -/* - includeVarProcedure - -*/ - -static void includeVarProcedure (decl_scopeT s); - -/* - includeVar - -*/ - -static void includeVar (decl_scopeT s); - -/* - includeExternals - -*/ - -static void includeExternals (decl_node n); - -/* - checkSystemInclude - -*/ - -static void checkSystemInclude (decl_node n); - -/* - addExported - -*/ - -static void addExported (decl_node n); - -/* - addExternal - only adds, n, if this symbol is external to the - implementation module and is not a hidden type. -*/ - -static void addExternal (decl_node n); - -/* - includeDefConstType - -*/ - -static void includeDefConstType (decl_node n); - -/* - runIncludeDefConstType - -*/ - -static void runIncludeDefConstType (decl_node n); - -/* - joinProcedures - copies procedures from definition module, - d, into implementation module, i. -*/ - -static void joinProcedures (decl_node i, decl_node d); - -/* - includeDefVarProcedure - -*/ - -static void includeDefVarProcedure (decl_node n); - -/* - foreachModuleDo - -*/ - -static void foreachModuleDo (decl_node n, symbolKey_performOperation p); - -/* - outDeclsImpC - -*/ - -static void outDeclsImpC (mcPretty_pretty p, decl_scopeT s); - -/* - doStatementSequenceC - -*/ - -static void doStatementSequenceC (mcPretty_pretty p, decl_node s); - -/* - isStatementSequenceEmpty - -*/ - -static unsigned int isStatementSequenceEmpty (decl_node s); - -/* - isSingleStatement - returns TRUE if the statement sequence, s, has - only one statement. -*/ - -static unsigned int isSingleStatement (decl_node s); - -/* - doCommentC - -*/ - -static void doCommentC (mcPretty_pretty p, decl_node s); - -/* - doAfterCommentC - emit an after comment, c, or a newline if, c, is empty. -*/ - -static void doAfterCommentC (mcPretty_pretty p, decl_node c); - -/* - doReturnC - issue a return statement and also place in an after comment if one exists. -*/ - -static void doReturnC (mcPretty_pretty p, decl_node s); - -/* - isZtypeEquivalent - -*/ - -static unsigned int isZtypeEquivalent (decl_node type); - -/* - isEquivalentType - returns TRUE if type1 and type2 are equivalent. -*/ - -static unsigned int isEquivalentType (decl_node type1, decl_node type2); - -/* - doExprCastC - build a cast if necessary. -*/ - -static void doExprCastC (mcPretty_pretty p, decl_node e, decl_node type); - -/* - requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ. -*/ - -static unsigned int requiresUnpackProc (decl_node s); - -/* - doAssignmentC - -*/ - -static void doAssignmentC (mcPretty_pretty p, decl_node s); - -/* - containsStatement - -*/ - -static unsigned int containsStatement (decl_node s); - -/* - doCompoundStmt - -*/ - -static void doCompoundStmt (mcPretty_pretty p, decl_node s); - -/* - doElsifC - -*/ - -static void doElsifC (mcPretty_pretty p, decl_node s); - -/* - noIfElse - -*/ - -static unsigned int noIfElse (decl_node n); - -/* - noIfElseChained - returns TRUE if, n, is an IF statement which - has no associated ELSE statement. An IF with an - ELSIF is also checked for no ELSE and will result - in a return value of TRUE. -*/ - -static unsigned int noIfElseChained (decl_node n); - -/* - hasIfElse - -*/ - -static unsigned int hasIfElse (decl_node n); - -/* - isIfElse - -*/ - -static unsigned int isIfElse (decl_node n); - -/* - hasIfAndNoElse - returns TRUE if statement, n, is a single statement - which is an IF and it has no else statement. -*/ - -static unsigned int hasIfAndNoElse (decl_node n); - -/* - doIfC - issue an if statement and also place in an after comment if one exists. - The if statement might contain an else or elsif which are also handled. -*/ - -static void doIfC (mcPretty_pretty p, decl_node s); - -/* - doForIncCP - -*/ - -static void doForIncCP (mcPretty_pretty p, decl_node s); - -/* - doForIncC - -*/ - -static void doForIncC (mcPretty_pretty p, decl_node s); - -/* - doForInc - -*/ - -static void doForInc (mcPretty_pretty p, decl_node s); - -/* - doForC - -*/ - -static void doForC (mcPretty_pretty p, decl_node s); - -/* - doRepeatC - -*/ - -static void doRepeatC (mcPretty_pretty p, decl_node s); - -/* - doWhileC - -*/ - -static void doWhileC (mcPretty_pretty p, decl_node s); - -/* - doFuncHighC - -*/ - -static void doFuncHighC (mcPretty_pretty p, decl_node a); - -/* - doMultiplyBySize - -*/ - -static void doMultiplyBySize (mcPretty_pretty p, decl_node a); - -/* - doTotype - -*/ - -static void doTotype (mcPretty_pretty p, decl_node a, decl_node t); - -/* - doFuncUnbounded - -*/ - -static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node formalParam, decl_node formal, decl_node func); - -/* - doProcedureParamC - -*/ - -static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal); - -/* - doAdrExprC - -*/ - -static void doAdrExprC (mcPretty_pretty p, decl_node n); - -/* - typePair - -*/ - -static unsigned int typePair (decl_node a, decl_node b, decl_node x, decl_node y); - -/* - needsCast - return TRUE if the actual type parameter needs to be cast to - the formal type. -*/ - -static unsigned int needsCast (decl_node at, decl_node ft); - -/* - checkSystemCast - checks to see if we are passing to/from - a system generic type (WORD, BYTE, ADDRESS) - and if so emit a cast. It returns the number of - open parenthesis. -*/ - -static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_node formal); - -/* - emitN - -*/ - -static void emitN (mcPretty_pretty p, const char *a_, unsigned int _a_high, unsigned int n); - -/* - isForC - return true if node n is a varparam, param or procedure - which was declared inside a definition module for "C". -*/ - -static unsigned int isForC (decl_node n); - -/* - isDefForCNode - return TRUE if node n was declared inside a definition module for "C". -*/ - -static unsigned int isDefForCNode (decl_node n); - -/* - doFuncParamC - -*/ - -static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal, decl_node func); - -/* - getNthParamType - return the type of parameter, i, in list, l. - If the parameter is a vararg NIL is returned. -*/ - -static decl_node getNthParamType (Indexing_Index l, unsigned int i); - -/* - getNthParam - return the parameter, i, in list, l. - If the parameter is a vararg NIL is returned. -*/ - -static decl_node getNthParam (Indexing_Index l, unsigned int i); - -/* - doFuncArgsC - -*/ - -static void doFuncArgsC (mcPretty_pretty p, decl_node s, Indexing_Index l, unsigned int needParen); - -/* - doProcTypeArgsC - -*/ - -static void doProcTypeArgsC (mcPretty_pretty p, decl_node s, Indexing_Index args, unsigned int needParen); - -/* - doAdrArgC - -*/ - -static void doAdrArgC (mcPretty_pretty p, decl_node n); - -/* - doAdrC - -*/ - -static void doAdrC (mcPretty_pretty p, decl_node n); - -/* - doInc - -*/ - -static void doInc (mcPretty_pretty p, decl_node n); - -/* - doDec - -*/ - -static void doDec (mcPretty_pretty p, decl_node n); - -/* - doIncDecC - -*/ - -static void doIncDecC (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high); - -/* - doIncDecCP - -*/ - -static void doIncDecCP (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high); - -/* - doInclC - -*/ - -static void doInclC (mcPretty_pretty p, decl_node n); - -/* - doExclC - -*/ - -static void doExclC (mcPretty_pretty p, decl_node n); - -/* - doNewC - -*/ - -static void doNewC (mcPretty_pretty p, decl_node n); - -/* - doDisposeC - -*/ - -static void doDisposeC (mcPretty_pretty p, decl_node n); - -/* - doCapC - -*/ - -static void doCapC (mcPretty_pretty p, decl_node n); - -/* - doLengthC - -*/ - -static void doLengthC (mcPretty_pretty p, decl_node n); - -/* - doAbsC - -*/ - -static void doAbsC (mcPretty_pretty p, decl_node n); - -/* - doValC - -*/ - -static void doValC (mcPretty_pretty p, decl_node n); - -/* - doMinC - -*/ - -static void doMinC (mcPretty_pretty p, decl_node n); - -/* - doMaxC - -*/ - -static void doMaxC (mcPretty_pretty p, decl_node n); - -/* - isIntrinsic - returns if, n, is an intrinsic procedure. - The intrinsic functions are represented as unary and binary nodes. -*/ - -static unsigned int isIntrinsic (decl_node n); - -/* - doHalt - -*/ - -static void doHalt (mcPretty_pretty p, decl_node n); - -/* - doCreal - emit the appropriate creal function. -*/ - -static void doCreal (mcPretty_pretty p, decl_node t); - -/* - doCimag - emit the appropriate cimag function. -*/ - -static void doCimag (mcPretty_pretty p, decl_node t); - -/* - doReC - -*/ - -static void doReC (mcPretty_pretty p, decl_node n); - -/* - doImC - -*/ - -static void doImC (mcPretty_pretty p, decl_node n); - -/* - doCmplx - -*/ - -static void doCmplx (mcPretty_pretty p, decl_node n); - -/* - doIntrinsicC - -*/ - -static void doIntrinsicC (mcPretty_pretty p, decl_node n); - -/* - isIntrinsicFunction - returns true if, n, is an instrinsic function. -*/ - -static unsigned int isIntrinsicFunction (decl_node n); - -/* - doSizeC - -*/ - -static void doSizeC (mcPretty_pretty p, decl_node n); - -/* - doConvertC - -*/ - -static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high); - -/* - getFuncFromExpr - -*/ - -static decl_node getFuncFromExpr (decl_node n); - -/* - doFuncExprC - -*/ - -static void doFuncExprC (mcPretty_pretty p, decl_node n); - -/* - doFuncCallC - -*/ - -static void doFuncCallC (mcPretty_pretty p, decl_node n); - -/* - doCaseStatementC - -*/ - -static void doCaseStatementC (mcPretty_pretty p, decl_node n, unsigned int needBreak); - -/* - doExceptionC - -*/ - -static void doExceptionC (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n); - -/* - doExceptionCP - -*/ - -static void doExceptionCP (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n); - -/* - doException - -*/ - -static void doException (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n); - -/* - doRangeListC - -*/ - -static void doRangeListC (mcPretty_pretty p, decl_node c); - -/* - doRangeIfListC - -*/ - -static void doRangeIfListC (mcPretty_pretty p, decl_node e, decl_node c); - -/* - doCaseLabels - -*/ - -static void doCaseLabels (mcPretty_pretty p, decl_node n, unsigned int needBreak); - -/* - doCaseLabelListC - -*/ - -static void doCaseLabelListC (mcPretty_pretty p, decl_node n, unsigned int haveElse); - -/* - doCaseIfLabels - -*/ - -static void doCaseIfLabels (mcPretty_pretty p, decl_node e, decl_node n, unsigned int i, unsigned int h); - -/* - doCaseIfLabelListC - -*/ - -static void doCaseIfLabelListC (mcPretty_pretty p, decl_node n); - -/* - doCaseElseC - -*/ - -static void doCaseElseC (mcPretty_pretty p, decl_node n); - -/* - doCaseIfElseC - -*/ - -static void doCaseIfElseC (mcPretty_pretty p, decl_node n); - -/* - canUseSwitchCaseLabels - returns TRUE if all the case labels are - single values and not ranges. -*/ - -static unsigned int canUseSwitchCaseLabels (decl_node n); - -/* - canUseSwitch - returns TRUE if the case statement can be implement - by a switch statement. This will be TRUE if all case - selectors are single values rather than ranges. -*/ - -static unsigned int canUseSwitch (decl_node n); - -/* - doCaseC - -*/ - -static void doCaseC (mcPretty_pretty p, decl_node n); - -/* - doLoopC - -*/ - -static void doLoopC (mcPretty_pretty p, decl_node s); - -/* - doExitC - -*/ - -static void doExitC (mcPretty_pretty p, decl_node s); - -/* - doStatementsC - -*/ - -static void doStatementsC (mcPretty_pretty p, decl_node s); -static void stop (void); - -/* - doLocalVarC - -*/ - -static void doLocalVarC (mcPretty_pretty p, decl_scopeT s); - -/* - doLocalConstTypesC - -*/ - -static void doLocalConstTypesC (mcPretty_pretty p, decl_scopeT s); - -/* - addParamDone - -*/ - -static void addParamDone (decl_node n); - -/* - includeParameters - -*/ - -static void includeParameters (decl_node n); - -/* - isHalt - -*/ - -static unsigned int isHalt (decl_node n); - -/* - isReturnOrHalt - -*/ - -static unsigned int isReturnOrHalt (decl_node n); - -/* - isLastStatementReturn - -*/ - -static unsigned int isLastStatementReturn (decl_node n); - -/* - isLastStatementSequence - -*/ - -static unsigned int isLastStatementSequence (decl_node n, decl_isNodeF q); - -/* - isLastStatementIf - -*/ - -static unsigned int isLastStatementIf (decl_node n, decl_isNodeF q); - -/* - isLastStatementElsif - -*/ - -static unsigned int isLastStatementElsif (decl_node n, decl_isNodeF q); - -/* - isLastStatementCase - -*/ - -static unsigned int isLastStatementCase (decl_node n, decl_isNodeF q); - -/* - isLastStatement - returns TRUE if the last statement in, n, is, q. -*/ - -static unsigned int isLastStatement (decl_node n, decl_isNodeF q); - -/* - doProcedureC - -*/ - -static void doProcedureC (decl_node n); - -/* - outProceduresC - -*/ - -static void outProceduresC (mcPretty_pretty p, decl_scopeT s); - -/* - output - -*/ - -static void output (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v); - -/* - allDependants - -*/ - -static decl_dependentState allDependants (decl_node n); - -/* - walkDependants - -*/ - -static decl_dependentState walkDependants (alists_alist l, decl_node n); - -/* - walkType - -*/ - -static decl_dependentState walkType (alists_alist l, decl_node n); - -/* - db - -*/ - -static void db (const char *a_, unsigned int _a_high, decl_node n); - -/* - dbt - -*/ - -static void dbt (const char *a_, unsigned int _a_high); - -/* - dbs - -*/ - -static void dbs (decl_dependentState s, decl_node n); - -/* - dbq - -*/ - -static void dbq (decl_node n); - -/* - walkRecord - -*/ - -static decl_dependentState walkRecord (alists_alist l, decl_node n); - -/* - walkVarient - -*/ - -static decl_dependentState walkVarient (alists_alist l, decl_node n); - -/* - queueBlocked - -*/ - -static void queueBlocked (decl_node n); - -/* - walkVar - -*/ - -static decl_dependentState walkVar (alists_alist l, decl_node n); - -/* - walkEnumeration - -*/ - -static decl_dependentState walkEnumeration (alists_alist l, decl_node n); - -/* - walkSubrange - -*/ - -static decl_dependentState walkSubrange (alists_alist l, decl_node n); - -/* - walkSubscript - -*/ - -static decl_dependentState walkSubscript (alists_alist l, decl_node n); - -/* - walkPointer - -*/ - -static decl_dependentState walkPointer (alists_alist l, decl_node n); - -/* - walkArray - -*/ - -static decl_dependentState walkArray (alists_alist l, decl_node n); - -/* - walkConst - -*/ - -static decl_dependentState walkConst (alists_alist l, decl_node n); - -/* - walkVarParam - -*/ - -static decl_dependentState walkVarParam (alists_alist l, decl_node n); - -/* - walkParam - -*/ - -static decl_dependentState walkParam (alists_alist l, decl_node n); - -/* - walkOptarg - -*/ - -static decl_dependentState walkOptarg (alists_alist l, decl_node n); - -/* - walkRecordField - -*/ - -static decl_dependentState walkRecordField (alists_alist l, decl_node n); - -/* - walkVarientField - -*/ - -static decl_dependentState walkVarientField (alists_alist l, decl_node n); - -/* - walkEnumerationField - -*/ - -static decl_dependentState walkEnumerationField (alists_alist l, decl_node n); - -/* - walkSet - -*/ - -static decl_dependentState walkSet (alists_alist l, decl_node n); - -/* - walkProcType - -*/ - -static decl_dependentState walkProcType (alists_alist l, decl_node n); - -/* - walkProcedure - -*/ - -static decl_dependentState walkProcedure (alists_alist l, decl_node n); - -/* - walkParameters - -*/ - -static decl_dependentState walkParameters (alists_alist l, Indexing_Index p); - -/* - walkFuncCall - -*/ - -static decl_dependentState walkFuncCall (alists_alist l, decl_node n); - -/* - walkUnary - -*/ - -static decl_dependentState walkUnary (alists_alist l, decl_node n); - -/* - walkBinary - -*/ - -static decl_dependentState walkBinary (alists_alist l, decl_node n); - -/* - walkComponentRef - -*/ - -static decl_dependentState walkComponentRef (alists_alist l, decl_node n); - -/* - walkPointerRef - -*/ - -static decl_dependentState walkPointerRef (alists_alist l, decl_node n); - -/* - walkSetValue - -*/ - -static decl_dependentState walkSetValue (alists_alist l, decl_node n); - -/* - doDependants - return the dependentState depending upon whether - all dependants have been declared. -*/ - -static decl_dependentState doDependants (alists_alist l, decl_node n); - -/* - tryComplete - returns TRUE if node, n, can be and was completed. -*/ - -static unsigned int tryComplete (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v); - -/* - tryCompleteFromPartial - -*/ - -static unsigned int tryCompleteFromPartial (decl_node n, decl_nodeProcedure t); - -/* - visitIntrinsicFunction - -*/ - -static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitUnary - -*/ - -static void visitUnary (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitBinary - -*/ - -static void visitBinary (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitBoolean - -*/ - -static void visitBoolean (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitScope - -*/ - -static void visitScope (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitType - -*/ - -static void visitType (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitIndex - -*/ - -static void visitIndex (alists_alist v, Indexing_Index i, decl_nodeProcedure p); - -/* - visitRecord - -*/ - -static void visitRecord (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitVarient - -*/ - -static void visitVarient (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitVar - -*/ - -static void visitVar (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitEnumeration - -*/ - -static void visitEnumeration (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitSubrange - -*/ - -static void visitSubrange (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitPointer - -*/ - -static void visitPointer (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitArray - -*/ - -static void visitArray (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitConst - -*/ - -static void visitConst (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitVarParam - -*/ - -static void visitVarParam (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitParam - -*/ - -static void visitParam (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitOptarg - -*/ - -static void visitOptarg (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitRecordField - -*/ - -static void visitRecordField (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitVarientField - -*/ - -static void visitVarientField (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitEnumerationField - -*/ - -static void visitEnumerationField (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitSet - -*/ - -static void visitSet (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitProcType - -*/ - -static void visitProcType (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitSubscript - -*/ - -static void visitSubscript (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitDecls - -*/ - -static void visitDecls (alists_alist v, decl_scopeT s, decl_nodeProcedure p); - -/* - visitProcedure - -*/ - -static void visitProcedure (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitDef - -*/ - -static void visitDef (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitImp - -*/ - -static void visitImp (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitModule - -*/ - -static void visitModule (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitLoop - -*/ - -static void visitLoop (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitWhile - -*/ - -static void visitWhile (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitRepeat - -*/ - -static void visitRepeat (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitCase - -*/ - -static void visitCase (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitCaseLabelList - -*/ - -static void visitCaseLabelList (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitCaseList - -*/ - -static void visitCaseList (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitRange - -*/ - -static void visitRange (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitIf - -*/ - -static void visitIf (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitElsif - -*/ - -static void visitElsif (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitFor - -*/ - -static void visitFor (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitAssignment - -*/ - -static void visitAssignment (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitComponentRef - -*/ - -static void visitComponentRef (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitPointerRef - -*/ - -static void visitPointerRef (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitArrayRef - -*/ - -static void visitArrayRef (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitFunccall - -*/ - -static void visitFunccall (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitVarDecl - -*/ - -static void visitVarDecl (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitExplist - -*/ - -static void visitExplist (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitExit - -*/ - -static void visitExit (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitReturn - -*/ - -static void visitReturn (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitStmtSeq - -*/ - -static void visitStmtSeq (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitVarargs - -*/ - -static void visitVarargs (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitSetValue - -*/ - -static void visitSetValue (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitIntrinsic - -*/ - -static void visitIntrinsic (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitDependants - helper procedure function called from visitNode. - node n has just been visited, this procedure will - visit node, n, dependants. -*/ - -static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - visitNode - visits node, n, if it is not already in the alist, v. - It calls p(n) if the node is unvisited. -*/ - -static void visitNode (alists_alist v, decl_node n, decl_nodeProcedure p); - -/* - genKind - returns a string depending upon the kind of node, n. -*/ - -static DynamicStrings_String genKind (decl_node n); - -/* - gen - generate a small string describing node, n. -*/ - -static DynamicStrings_String gen (decl_node n); - -/* - dumpQ - -*/ - -static void dumpQ (const char *q_, unsigned int _q_high, alists_alist l); - -/* - dumpLists - -*/ - -static void dumpLists (void); - -/* - outputHidden - -*/ - -static void outputHidden (decl_node n); - -/* - outputHiddenComplete - -*/ - -static void outputHiddenComplete (decl_node n); - -/* - tryPartial - -*/ - -static unsigned int tryPartial (decl_node n, decl_nodeProcedure pt); - -/* - outputPartialRecordArrayProcType - -*/ - -static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection); - -/* - outputPartial - -*/ - -static void outputPartial (decl_node n); - -/* - tryOutputTodo - -*/ - -static void tryOutputTodo (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure pt); - -/* - tryOutputPartial - -*/ - -static void tryOutputPartial (decl_nodeProcedure t); - -/* - debugList - -*/ - -static void debugList (const char *a_, unsigned int _a_high, alists_alist l); - -/* - debugLists - -*/ - -static void debugLists (void); - -/* - addEnumConst - -*/ - -static void addEnumConst (decl_node n); - -/* - populateTodo - -*/ - -static void populateTodo (decl_nodeProcedure p); - -/* - topologicallyOut - -*/ - -static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, decl_nodeProcedure pt, decl_nodeProcedure pv); - -/* - scaffoldStatic - -*/ - -static void scaffoldStatic (mcPretty_pretty p, decl_node n); - -/* - emitCtor - -*/ - -static void emitCtor (mcPretty_pretty p, decl_node n); - -/* - scaffoldDynamic - -*/ - -static void scaffoldDynamic (mcPretty_pretty p, decl_node n); - -/* - scaffoldMain - -*/ - -static void scaffoldMain (mcPretty_pretty p, decl_node n); - -/* - outImpInitC - emit the init/fini functions and main function if required. -*/ - -static void outImpInitC (mcPretty_pretty p, decl_node n); - -/* - runSimplifyTypes - -*/ - -static void runSimplifyTypes (decl_node n); - -/* - outDefC - -*/ - -static void outDefC (mcPretty_pretty p, decl_node n); - -/* - runPrototypeExported - -*/ - -static void runPrototypeExported (decl_node n); - -/* - runPrototypeDefC - -*/ - -static void runPrototypeDefC (decl_node n); - -/* - outImpC - -*/ - -static void outImpC (mcPretty_pretty p, decl_node n); - -/* - outDeclsModuleC - -*/ - -static void outDeclsModuleC (mcPretty_pretty p, decl_scopeT s); - -/* - outModuleInitC - -*/ - -static void outModuleInitC (mcPretty_pretty p, decl_node n); - -/* - outModuleC - -*/ - -static void outModuleC (mcPretty_pretty p, decl_node n); - -/* - outC - -*/ - -static void outC (mcPretty_pretty p, decl_node n); - -/* - doIncludeM2 - include modules in module, n. -*/ - -static void doIncludeM2 (decl_node n); - -/* - doConstM2 - -*/ - -static void doConstM2 (decl_node n); - -/* - doProcTypeM2 - -*/ - -static void doProcTypeM2 (mcPretty_pretty p, decl_node n); - -/* - doRecordFieldM2 - -*/ - -static void doRecordFieldM2 (mcPretty_pretty p, decl_node f); - -/* - doVarientFieldM2 - -*/ - -static void doVarientFieldM2 (mcPretty_pretty p, decl_node n); - -/* - doVarientM2 - -*/ - -static void doVarientM2 (mcPretty_pretty p, decl_node n); - -/* - doRecordM2 - -*/ - -static void doRecordM2 (mcPretty_pretty p, decl_node n); - -/* - doPointerM2 - -*/ - -static void doPointerM2 (mcPretty_pretty p, decl_node n); - -/* - doTypeAliasM2 - -*/ - -static void doTypeAliasM2 (mcPretty_pretty p, decl_node n); - -/* - doEnumerationM2 - -*/ - -static void doEnumerationM2 (mcPretty_pretty p, decl_node n); - -/* - doBaseM2 - -*/ - -static void doBaseM2 (mcPretty_pretty p, decl_node n); - -/* - doSystemM2 - -*/ - -static void doSystemM2 (mcPretty_pretty p, decl_node n); - -/* - doTypeM2 - -*/ - -static void doTypeM2 (mcPretty_pretty p, decl_node n); - -/* - doTypesM2 - -*/ - -static void doTypesM2 (decl_node n); - -/* - doVarM2 - -*/ - -static void doVarM2 (decl_node n); - -/* - doVarsM2 - -*/ - -static void doVarsM2 (decl_node n); - -/* - doTypeNameM2 - -*/ - -static void doTypeNameM2 (mcPretty_pretty p, decl_node n); - -/* - doParamM2 - -*/ - -static void doParamM2 (mcPretty_pretty p, decl_node n); - -/* - doVarParamM2 - -*/ - -static void doVarParamM2 (mcPretty_pretty p, decl_node n); - -/* - doParameterM2 - -*/ - -static void doParameterM2 (mcPretty_pretty p, decl_node n); - -/* - doPrototypeM2 - -*/ - -static void doPrototypeM2 (decl_node n); - -/* - outputPartialM2 - just writes out record, array, and proctypes. - No need for forward declarations in Modula-2 - but we need to keep topological sort happy. - So when asked to output partial we emit the - full type for these types and then do nothing - when trying to complete partial to full. -*/ - -static void outputPartialM2 (decl_node n); - -/* - outDeclsDefM2 - -*/ - -static void outDeclsDefM2 (mcPretty_pretty p, decl_scopeT s); - -/* - outDefM2 - -*/ - -static void outDefM2 (mcPretty_pretty p, decl_node n); - -/* - outDeclsImpM2 - -*/ - -static void outDeclsImpM2 (mcPretty_pretty p, decl_scopeT s); - -/* - outImpM2 - -*/ - -static void outImpM2 (mcPretty_pretty p, decl_node n); - -/* - outModuleM2 - -*/ - -static void outModuleM2 (mcPretty_pretty p, decl_node n); - -/* - outM2 - -*/ - -static void outM2 (mcPretty_pretty p, decl_node n); - -/* - addDone - adds node, n, to the doneQ. -*/ - -static void addDone (decl_node n); - -/* - addDoneDef - adds node, n, to the doneQ providing - it is not an opaque of the main module we are compiling. -*/ - -static void addDoneDef (decl_node n); - -/* - dbgAdd - -*/ - -static decl_node dbgAdd (alists_alist l, decl_node n); - -/* - dbgType - -*/ - -static void dbgType (alists_alist l, decl_node n); - -/* - dbgPointer - -*/ - -static void dbgPointer (alists_alist l, decl_node n); - -/* - dbgRecord - -*/ - -static void dbgRecord (alists_alist l, decl_node n); - -/* - dbgVarient - -*/ - -static void dbgVarient (alists_alist l, decl_node n); - -/* - dbgEnumeration - -*/ - -static void dbgEnumeration (alists_alist l, decl_node n); - -/* - dbgVar - -*/ - -static void dbgVar (alists_alist l, decl_node n); - -/* - dbgSubrange - -*/ - -static void dbgSubrange (alists_alist l, decl_node n); - -/* - dbgArray - -*/ - -static void dbgArray (alists_alist l, decl_node n); - -/* - doDbg - -*/ - -static void doDbg (alists_alist l, decl_node n); - -/* - dbg - -*/ - -static void dbg (decl_node n); - -/* - addGenericBody - adds comment node to funccall, return, assignment - nodes. -*/ - -static void addGenericBody (decl_node n, decl_node c); - -/* - addGenericAfter - adds comment node to funccall, return, assignment - nodes. -*/ - -static void addGenericAfter (decl_node n, decl_node c); - -/* - isAssignment - -*/ - -static unsigned int isAssignment (decl_node n); - -/* - isComment - returns TRUE if node, n, is a comment. -*/ - -static unsigned int isComment (decl_node n); - -/* - initPair - initialise the commentPair, c. -*/ - -static void initPair (decl_commentPair *c); - -/* - dupExplist - -*/ - -static decl_node dupExplist (decl_node n); - -/* - dupArrayref - -*/ - -static decl_node dupArrayref (decl_node n); - -/* - dupPointerref - -*/ - -static decl_node dupPointerref (decl_node n); - -/* - dupComponentref - -*/ - -static decl_node dupComponentref (decl_node n); - -/* - dupBinary - -*/ - -static decl_node dupBinary (decl_node n); - -/* - dupUnary - -*/ - -static decl_node dupUnary (decl_node n); - -/* - dupFunccall - -*/ - -static decl_node dupFunccall (decl_node n); - -/* - dupSetValue - -*/ - -static decl_node dupSetValue (decl_node n); - -/* - doDupExpr - -*/ - -static decl_node doDupExpr (decl_node n); - -/* - makeSystem - -*/ - -static void makeSystem (void); - -/* - makeM2rts - -*/ - -static void makeM2rts (void); - -/* - makeBitnum - -*/ - -static decl_node makeBitnum (void); - -/* - makeBaseSymbols - -*/ - -static void makeBaseSymbols (void); - -/* - makeBuiltins - -*/ - -static void makeBuiltins (void); - -/* - init - -*/ - -static void init (void); - - -/* - newNode - create and return a new node of kind k. -*/ - -static decl_node newNode (decl_nodeT k) -{ - decl_node d; - - Storage_ALLOCATE ((void **) &d, sizeof (decl_nodeRec)); - if (enableMemsetOnAllocation) - { - d = static_cast (libc_memset (reinterpret_cast (d), 0, static_cast (sizeof ((*d))))); - } - if (d == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - d->kind = k; - d->at.defDeclared = 0; - d->at.modDeclared = 0; - d->at.firstUsed = 0; - return d; - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - disposeNode - dispose node, n. -*/ - -static void disposeNode (decl_node *n) -{ - Storage_DEALLOCATE ((void **) &(*n), sizeof (decl_nodeRec)); - (*n) = NULL; -} - - -/* - isLocal - returns TRUE if symbol, n, is locally declared in a procedure. -*/ - -static unsigned int isLocal (decl_node n) -{ - decl_node s; - - s = decl_getScope (n); - if (s != NULL) - { - return decl_isProcedure (s); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - importEnumFields - if, n, is an enumeration type import the all fields into module, m. -*/ - -static void importEnumFields (decl_node m, decl_node n) -{ - decl_node r; - decl_node e; - unsigned int i; - unsigned int h; - - mcDebug_assert (((decl_isDef (m)) || (decl_isModule (m))) || (decl_isImp (m))); - n = decl_skipType (n); - if ((n != NULL) && (decl_isEnumeration (n))) - { - i = Indexing_LowIndice (n->enumerationF.listOfSons); - h = Indexing_HighIndice (n->enumerationF.listOfSons); - while (i <= h) - { - e = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); - r = decl_import (m, e); - if (e != r) - { - mcMetaError_metaError2 ((const char *) "enumeration field {%1ad} cannot be imported implicitly into {%2d} due to a name clash", 85, (const unsigned char *) &e, (sizeof (e)-1), (const unsigned char *) &m, (sizeof (m)-1)); - } - i += 1; - } - } -} - - -/* - isComplex - returns TRUE if, n, is the complex type. -*/ - -static unsigned int isComplex (decl_node n) -{ - return n == complexN; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLongComplex - returns TRUE if, n, is the longcomplex type. -*/ - -static unsigned int isLongComplex (decl_node n) -{ - return n == longcomplexN; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isShortComplex - returns TRUE if, n, is the shortcomplex type. -*/ - -static unsigned int isShortComplex (decl_node n) -{ - return n == shortcomplexN; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isAProcType - returns TRUE if, n, is a proctype or proc node. -*/ - -static unsigned int isAProcType (decl_node n) -{ - mcDebug_assert (n != NULL); - return (decl_isProcType (n)) || (n == procN); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - initFixupInfo - initialize the fixupInfo record. -*/ - -static decl_fixupInfo initFixupInfo (void) -{ - decl_fixupInfo f; - - f.count = 0; - f.info = Indexing_InitIndex (1); - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeDef - returns a definition module node named, n. -*/ - -static decl_node makeDef (nameKey_Name n) -{ - decl_node d; - - d = newNode (decl_def); - d->defF.name = n; - d->defF.source = nameKey_NulName; - d->defF.hasHidden = FALSE; - d->defF.forC = FALSE; - d->defF.exported = Indexing_InitIndex (1); - d->defF.importedModules = Indexing_InitIndex (1); - d->defF.constFixup = initFixupInfo (); - d->defF.enumFixup = initFixupInfo (); - initDecls (&d->defF.decls); - d->defF.enumsComplete = FALSE; - d->defF.constsComplete = FALSE; - d->defF.visited = FALSE; - initPair (&d->defF.com); - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeImp - returns an implementation module node named, n. -*/ - -static decl_node makeImp (nameKey_Name n) -{ - decl_node d; - - d = newNode (decl_imp); - d->impF.name = n; - d->impF.source = nameKey_NulName; - d->impF.importedModules = Indexing_InitIndex (1); - d->impF.constFixup = initFixupInfo (); - d->impF.enumFixup = initFixupInfo (); - initDecls (&d->impF.decls); - d->impF.beginStatements = NULL; - d->impF.finallyStatements = NULL; - d->impF.definitionModule = NULL; - d->impF.enumsComplete = FALSE; - d->impF.constsComplete = FALSE; - d->impF.visited = FALSE; - initPair (&d->impF.com); - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeModule - returns a module node named, n. -*/ - -static decl_node makeModule (nameKey_Name n) -{ - decl_node d; - - d = newNode (decl_module); - d->moduleF.name = n; - d->moduleF.source = nameKey_NulName; - d->moduleF.importedModules = Indexing_InitIndex (1); - d->moduleF.constFixup = initFixupInfo (); - d->moduleF.enumFixup = initFixupInfo (); - initDecls (&d->moduleF.decls); - d->moduleF.beginStatements = NULL; - d->moduleF.finallyStatements = NULL; - d->moduleF.enumsComplete = FALSE; - d->moduleF.constsComplete = FALSE; - d->moduleF.visited = FALSE; - initPair (&d->moduleF.com); - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isDefForC - returns TRUE if the definition module was defined FOR "C". -*/ - -static unsigned int isDefForC (decl_node n) -{ - return (decl_isDef (n)) && n->defF.forC; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - initDecls - initialize the decls, scopeT. -*/ - -static void initDecls (decl_scopeT *decls) -{ - (*decls).symbols = symbolKey_initTree (); - (*decls).constants = Indexing_InitIndex (1); - (*decls).types = Indexing_InitIndex (1); - (*decls).procedures = Indexing_InitIndex (1); - (*decls).variables = Indexing_InitIndex (1); -} - - -/* - addTo - adds node, d, to scope decls and returns, d. - It stores, d, in the symbols tree associated with decls. -*/ - -static decl_node addTo (decl_scopeT *decls, decl_node d) -{ - nameKey_Name n; - - n = decl_getSymName (d); - if (n != nameKey_NulName) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((symbolKey_getSymKey ((*decls).symbols, n)) == NULL) - { - symbolKey_putSymKey ((*decls).symbols, n, reinterpret_cast (d)); - } - else - { - mcMetaError_metaError1 ((const char *) "{%1DMad} was declared", 21, (const unsigned char *) &d, (sizeof (d)-1)); - mcMetaError_metaError1 ((const char *) "{%1k} and is being declared again", 33, (const unsigned char *) &n, (sizeof (n)-1)); - } - } - if (decl_isConst (d)) - { - Indexing_IncludeIndiceIntoIndex ((*decls).constants, reinterpret_cast (d)); - } - else if (decl_isVar (d)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex ((*decls).variables, reinterpret_cast (d)); - } - else if (decl_isType (d)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex ((*decls).types, reinterpret_cast (d)); - } - else if (decl_isProcedure (d)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex ((*decls).procedures, reinterpret_cast (d)); - if (debugDecl) - { - libc_printf ((const char *) "%d procedures on the dynamic array\\n", 36, Indexing_HighIndice ((*decls).procedures)); - } - } - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - export - export node, n, from definition module, d. -*/ - -static void export_ (decl_node d, decl_node n) -{ - mcDebug_assert (decl_isDef (d)); - Indexing_IncludeIndiceIntoIndex (d->defF.exported, reinterpret_cast (n)); -} - - -/* - addToScope - adds node, n, to the current scope and returns, n. -*/ - -static decl_node addToScope (decl_node n) -{ - decl_node s; - unsigned int i; - - i = Indexing_HighIndice (scopeStack); - s = static_cast (Indexing_GetIndice (scopeStack, i)); - if (decl_isProcedure (s)) - { - if (debugDecl) - { - outText (doP, (const char *) "adding ", 7); - doNameC (doP, n); - outText (doP, (const char *) " to procedure\\n", 15); - } - return addTo (&s->procedureF.decls, n); - } - else if (decl_isModule (s)) - { - /* avoid dangling else. */ - if (debugDecl) - { - outText (doP, (const char *) "adding ", 7); - doNameC (doP, n); - outText (doP, (const char *) " to module\\n", 12); - } - return addTo (&s->moduleF.decls, n); - } - else if (decl_isDef (s)) - { - /* avoid dangling else. */ - if (debugDecl) - { - outText (doP, (const char *) "adding ", 7); - doNameC (doP, n); - outText (doP, (const char *) " to definition module\\n", 23); - } - export_ (s, n); - return addTo (&s->defF.decls, n); - } - else if (decl_isImp (s)) - { - /* avoid dangling else. */ - if (debugDecl) - { - outText (doP, (const char *) "adding ", 7); - doNameC (doP, n); - outText (doP, (const char *) " to implementation module\\n", 27); - } - return addTo (&s->impF.decls, n); - } - M2RTS_HALT (-1); - __builtin_unreachable (); - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - addModuleToScope - adds module, i, to module, m, scope. -*/ - -static void addModuleToScope (decl_node m, decl_node i) -{ - mcDebug_assert ((decl_getDeclScope ()) == m); - if ((decl_lookupSym (decl_getSymName (i))) == NULL) - { - i = addToScope (i); - } -} - - -/* - completedEnum - assign boolean enumsComplete to TRUE if a definition, - implementation or module symbol. -*/ - -static void completedEnum (decl_node n) -{ - mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n))); - if (decl_isDef (n)) - { - n->defF.enumsComplete = TRUE; - } - else if (decl_isImp (n)) - { - /* avoid dangling else. */ - n->impF.enumsComplete = TRUE; - } - else if (decl_isModule (n)) - { - /* avoid dangling else. */ - n->moduleF.enumsComplete = TRUE; - } -} - - -/* - setUnary - sets a unary node to contain, arg, a, and type, t. -*/ - -static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t) -{ - switch (k) - { - case decl_constexp: - case decl_deref: - case decl_chr: - case decl_cap: - case decl_abs: - case decl_float: - case decl_trunc: - case decl_ord: - case decl_high: - case decl_throw: - case decl_re: - case decl_im: - case decl_not: - case decl_neg: - case decl_adr: - case decl_size: - case decl_tsize: - case decl_min: - case decl_max: - u->kind = k; - u->unaryF.arg = a; - u->unaryF.resultType = t; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - putVarBool - assigns the four booleans associated with a variable. -*/ - -static void putVarBool (decl_node v, unsigned int init, unsigned int param, unsigned int isvar, unsigned int isused) -{ - mcDebug_assert (decl_isVar (v)); - v->varF.isInitialised = init; - v->varF.isParameter = param; - v->varF.isVarParameter = isvar; - v->varF.isUsed = isused; -} - - -/* - checkPtr - in C++ we need to create a typedef for a pointer - in case we need to use reinterpret_cast. -*/ - -static decl_node checkPtr (decl_node n) -{ - DynamicStrings_String s; - decl_node p; - - if (lang == decl_ansiCP) - { - if (decl_isPointer (n)) - { - s = tempName (); - p = decl_makeType (nameKey_makekey (DynamicStrings_string (s))); - decl_putType (p, n); - s = DynamicStrings_KillString (s); - return p; - } - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isVarDecl - returns TRUE if, n, is a vardecl node. -*/ - -static unsigned int isVarDecl (decl_node n) -{ - return n->kind == decl_vardecl; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeVariablesFromParameters - creates variables which are really parameters. -*/ - -static void makeVariablesFromParameters (decl_node proc, decl_node id, decl_node type, unsigned int isvar, unsigned int isused) -{ - decl_node v; - unsigned int i; - unsigned int n; - nameKey_Name m; - DynamicStrings_String s; - - mcDebug_assert (decl_isProcedure (proc)); - mcDebug_assert (isIdentList (id)); - i = 1; - n = wlists_noOfItemsInList (id->identlistF.names); - while (i <= n) - { - m = static_cast (wlists_getItemFromList (id->identlistF.names, i)); - v = decl_makeVar (m); - decl_putVar (v, type, NULL); - putVarBool (v, TRUE, TRUE, isvar, isused); - if (debugScopes) - { - libc_printf ((const char *) "adding parameter variable into top scope\\n", 42); - dumpScopes (); - libc_printf ((const char *) " variable name is: ", 19); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (m)); - if ((DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, s))) == NULL) - {} /* empty. */ - libc_printf ((const char *) "\\n", 2); - } - i += 1; - } -} - - -/* - addProcedureToScope - add a procedure name n and node d to the - current scope. -*/ - -static decl_node addProcedureToScope (decl_node d, nameKey_Name n) -{ - decl_node m; - unsigned int i; - - i = Indexing_HighIndice (scopeStack); - m = static_cast (Indexing_GetIndice (scopeStack, i)); - if (((decl_isDef (m)) && ((decl_getSymName (m)) == (nameKey_makeKey ((const char *) "M2RTS", 5)))) && ((decl_getSymName (d)) == (nameKey_makeKey ((const char *) "HALT", 4)))) - { - haltN = d; - symbolKey_putSymKey (baseSymbols, n, reinterpret_cast (haltN)); - } - return addToScope (d); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putProcTypeReturn - sets the return type of, proc, to, type. -*/ - -static void putProcTypeReturn (decl_node proc, decl_node type) -{ - mcDebug_assert (decl_isProcType (proc)); - proc->proctypeF.returnType = type; -} - - -/* - putProcTypeOptReturn - sets, proc, to have an optional return type. -*/ - -static void putProcTypeOptReturn (decl_node proc) -{ - mcDebug_assert (decl_isProcType (proc)); - proc->proctypeF.returnopt = TRUE; -} - - -/* - makeOptParameter - creates and returns an optarg. -*/ - -static decl_node makeOptParameter (decl_node l, decl_node type, decl_node init) -{ - decl_node n; - - n = newNode (decl_optarg); - n->optargF.namelist = l; - n->optargF.type = type; - n->optargF.init = init; - n->optargF.scope = NULL; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setwatch - assign the globalNode to n. -*/ - -static unsigned int setwatch (decl_node n) -{ - globalNode = n; - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - runwatch - set the globalNode to an identlist. -*/ - -static unsigned int runwatch (void) -{ - return globalNode->kind == decl_identlist; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isIdentList - returns TRUE if, n, is an identlist. -*/ - -static unsigned int isIdentList (decl_node n) -{ - return n->kind == decl_identlist; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - identListLen - returns the length of identlist. -*/ - -static unsigned int identListLen (decl_node n) -{ - if (n == NULL) - { - return 0; - } - else - { - mcDebug_assert (isIdentList (n)); - return wlists_noOfItemsInList (n->identlistF.names); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkParameters - placeholder for future parameter checking. -*/ - -static void checkParameters (decl_node p, decl_node i, decl_node type, unsigned int isvar, unsigned int isused) -{ - /* do check. */ - disposeNode (&i); -} - - -/* - checkMakeVariables - create shadow local variables for parameters providing that - procedure n has not already been built and we are compiling - a module or an implementation module. -*/ - -static void checkMakeVariables (decl_node n, decl_node i, decl_node type, unsigned int isvar, unsigned int isused) -{ - if (((decl_isImp (currentModule)) || (decl_isModule (currentModule))) && ! n->procedureF.built) - { - makeVariablesFromParameters (n, i, type, isvar, isused); - } -} - - -/* - makeVarientField - create a varient field within varient, v, - The new varient field is returned. -*/ - -static decl_node makeVarientField (decl_node v, decl_node p) -{ - decl_node n; - - n = newNode (decl_varientfield); - n->varientfieldF.name = nameKey_NulName; - n->varientfieldF.parent = p; - n->varientfieldF.varient = v; - n->varientfieldF.simple = FALSE; - n->varientfieldF.listOfSons = Indexing_InitIndex (1); - n->varientfieldF.scope = decl_getDeclScope (); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putFieldVarient - places the field varient, f, as a brother to, the - varient symbol, v, and also tells, f, that its varient - parent is, v. -*/ - -static void putFieldVarient (decl_node f, decl_node v) -{ - mcDebug_assert (decl_isVarient (v)); - mcDebug_assert (decl_isVarientField (f)); - switch (v->kind) - { - case decl_varient: - Indexing_IncludeIndiceIntoIndex (v->varientF.listOfSons, reinterpret_cast (f)); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - switch (f->kind) - { - case decl_varientfield: - f->varientfieldF.varient = v; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - putFieldRecord - create a new recordfield and place it into record r. - The new field has a tagname and type and can have a - variant field v. -*/ - -static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type, decl_node v) -{ - decl_node f; - decl_node n; - decl_node p; - - n = newNode (decl_recordfield); - switch (r->kind) - { - case decl_record: - Indexing_IncludeIndiceIntoIndex (r->recordF.listOfSons, reinterpret_cast (n)); - /* ensure that field, n, is in the parents Local Symbols. */ - if (tag != nameKey_NulName) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((symbolKey_getSymKey (r->recordF.localSymbols, tag)) == symbolKey_NulKey) - { - symbolKey_putSymKey (r->recordF.localSymbols, tag, reinterpret_cast (n)); - } - else - { - f = static_cast (symbolKey_getSymKey (r->recordF.localSymbols, tag)); - mcMetaError_metaErrors1 ((const char *) "field record {%1Dad} has already been declared", 46, (const char *) "field record duplicate", 22, (const unsigned char *) &f, (sizeof (f)-1)); - } - } - break; - - case decl_varientfield: - Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast (n)); - p = getParent (r); - mcDebug_assert (p->kind == decl_record); - if (tag != nameKey_NulName) - { - symbolKey_putSymKey (p->recordF.localSymbols, tag, reinterpret_cast (n)); - } - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* fill in, n. */ - n->recordfieldF.type = type; - n->recordfieldF.name = tag; - n->recordfieldF.parent = r; - n->recordfieldF.varient = v; - n->recordfieldF.tag = FALSE; - n->recordfieldF.scope = NULL; - initCname (&n->recordfieldF.cname); - /* - IF r^.kind=record - THEN - doRecordM2 (doP, r) - END ; - */ - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ensureOrder - ensures that, a, and, b, exist in, i, and also - ensure that, a, is before, b. -*/ - -static void ensureOrder (Indexing_Index i, decl_node a, decl_node b) -{ - mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast (a))); - mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast (b))); - Indexing_RemoveIndiceFromIndex (i, reinterpret_cast (a)); - Indexing_RemoveIndiceFromIndex (i, reinterpret_cast (b)); - Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast (a)); - Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast (b)); - mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast (a))); - mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast (b))); -} - - -/* - putVarientTag - places tag into variant v. -*/ - -static void putVarientTag (decl_node v, decl_node tag) -{ - decl_node p; - - mcDebug_assert (decl_isVarient (v)); - switch (v->kind) - { - case decl_varient: - v->varientF.tag = tag; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - getParent - returns the parent field of recordfield or varientfield symbol, n. -*/ - -static decl_node getParent (decl_node n) -{ - switch (n->kind) - { - case decl_recordfield: - return n->recordfieldF.parent; - break; - - case decl_varientfield: - return n->varientfieldF.parent; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getRecord - returns the record associated with node, n. - (Parental record). -*/ - -static decl_node getRecord (decl_node n) -{ - mcDebug_assert (n->kind != decl_varient); /* if this fails then we need to add parent field to varient. */ - switch (n->kind) - { - case decl_record: - return n; /* if this fails then we need to add parent field to varient. */ - break; - - case decl_varientfield: - return getRecord (getParent (n)); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isConstExp - return TRUE if the node kind is a constexp. -*/ - -static unsigned int isConstExp (decl_node c) -{ - mcDebug_assert (c != NULL); - return c->kind == decl_constexp; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addEnumToModule - adds enumeration type, e, into the list of enums - in module, m. -*/ - -static void addEnumToModule (decl_node m, decl_node e) -{ - mcDebug_assert ((decl_isEnumeration (e)) || (decl_isEnumerationField (e))); - mcDebug_assert (((decl_isModule (m)) || (decl_isDef (m))) || (decl_isImp (m))); - if (decl_isModule (m)) - { - Indexing_IncludeIndiceIntoIndex (m->moduleF.enumFixup.info, reinterpret_cast (e)); - } - else if (decl_isDef (m)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex (m->defF.enumFixup.info, reinterpret_cast (e)); - } - else if (decl_isImp (m)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex (m->impF.enumFixup.info, reinterpret_cast (e)); - } -} - - -/* - getNextFixup - return the next fixup from from f. -*/ - -static decl_node getNextFixup (decl_fixupInfo *f) -{ - (*f).count += 1; - return static_cast (Indexing_GetIndice ((*f).info, (*f).count)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doMakeEnum - create an enumeration type and add it to the current module. -*/ - -static decl_node doMakeEnum (void) -{ - decl_node e; - - e = newNode (decl_enumeration); - e->enumerationF.noOfElements = 0; - e->enumerationF.localSymbols = symbolKey_initTree (); - e->enumerationF.scope = decl_getDeclScope (); - e->enumerationF.listOfSons = Indexing_InitIndex (1); - e->enumerationF.low = NULL; - e->enumerationF.high = NULL; - addEnumToModule (currentModule, e); - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doMakeEnumField - create an enumeration field name and add it to enumeration e. - Return the new field. -*/ - -static decl_node doMakeEnumField (decl_node e, nameKey_Name n) -{ - decl_node f; - - mcDebug_assert (decl_isEnumeration (e)); - f = decl_lookupSym (n); - if (f == NULL) - { - f = newNode (decl_enumerationfield); - symbolKey_putSymKey (e->enumerationF.localSymbols, n, reinterpret_cast (f)); - Indexing_IncludeIndiceIntoIndex (e->enumerationF.listOfSons, reinterpret_cast (f)); - f->enumerationfieldF.name = n; - f->enumerationfieldF.type = e; - f->enumerationfieldF.scope = decl_getDeclScope (); - f->enumerationfieldF.value = e->enumerationF.noOfElements; - initCname (&f->enumerationfieldF.cname); - e->enumerationF.noOfElements += 1; - mcDebug_assert ((Indexing_GetIndice (e->enumerationF.listOfSons, e->enumerationF.noOfElements)) == f); - addEnumToModule (currentModule, f); - if (e->enumerationF.low == NULL) - { - e->enumerationF.low = f; - } - e->enumerationF.high = f; - return addToScope (f); - } - else - { - mcMetaError_metaErrors2 ((const char *) "cannot create enumeration field {%1k} as the name is already in use", 67, (const char *) "{%2DMad} was declared elsewhere", 31, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &f, (sizeof (f)-1)); - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getExpList - returns the, n, th argument in an explist. -*/ - -static decl_node getExpList (decl_node p, unsigned int n) -{ - mcDebug_assert (p != NULL); - mcDebug_assert (decl_isExpList (p)); - mcDebug_assert (n <= (Indexing_HighIndice (p->explistF.exp))); - return static_cast (Indexing_GetIndice (p->explistF.exp, n)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - expListLen - returns the length of explist, p. -*/ - -static unsigned int expListLen (decl_node p) -{ - if (p == NULL) - { - return 0; - } - else - { - mcDebug_assert (decl_isExpList (p)); - return Indexing_HighIndice (p->explistF.exp); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getConstExpComplete - gets the field from the def or imp or module, n. -*/ - -static unsigned int getConstExpComplete (decl_node n) -{ - switch (n->kind) - { - case decl_def: - return n->defF.constsComplete; - break; - - case decl_imp: - return n->impF.constsComplete; - break; - - case decl_module: - return n->moduleF.constsComplete; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addConstToModule - adds const exp, e, into the list of constant - expressions in module, m. -*/ - -static void addConstToModule (decl_node m, decl_node e) -{ - mcDebug_assert (((decl_isModule (m)) || (decl_isDef (m))) || (decl_isImp (m))); - if (decl_isModule (m)) - { - Indexing_IncludeIndiceIntoIndex (m->moduleF.constFixup.info, reinterpret_cast (e)); - } - else if (decl_isDef (m)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex (m->defF.constFixup.info, reinterpret_cast (e)); - } - else if (decl_isImp (m)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex (m->impF.constFixup.info, reinterpret_cast (e)); - } -} - - -/* - doMakeConstExp - create a constexp node and add it to the current module. -*/ - -static decl_node doMakeConstExp (void) -{ - decl_node c; - - c = makeUnary (decl_constexp, NULL, NULL); - addConstToModule (currentModule, c); - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isAnyType - return TRUE if node n is any type kind. -*/ - -static unsigned int isAnyType (decl_node n) -{ - mcDebug_assert (n != NULL); - switch (n->kind) - { - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - case decl_bitset: - case decl_boolean: - case decl_proc: - case decl_type: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeVal - creates a VAL (type, expression) node. -*/ - -static decl_node makeVal (decl_node params) -{ - mcDebug_assert (decl_isExpList (params)); - if ((expListLen (params)) == 2) - { - return makeBinary (decl_val, getExpList (params, 1), getExpList (params, 2), getExpList (params, 1)); - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - makeCast - creates a cast node TYPENAME (expr). -*/ - -static decl_node makeCast (decl_node c, decl_node p) -{ - mcDebug_assert (decl_isExpList (p)); - if ((expListLen (p)) == 1) - { - return makeBinary (decl_cast, c, getExpList (p, 1), c); - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - -static decl_node makeIntrinsicProc (decl_nodeT k, unsigned int noArgs, decl_node p) -{ - decl_node f; - - /* - makeIntrisicProc - create an intrinsic node. - */ - f = newNode (k); - f->intrinsicF.args = p; - f->intrinsicF.noArgs = noArgs; - f->intrinsicF.type = NULL; - f->intrinsicF.postUnreachable = k == decl_halt; - initPair (&f->intrinsicF.intrinsicComment); - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeIntrinsicUnaryType - create an intrisic unary type. -*/ - -static decl_node makeIntrinsicUnaryType (decl_nodeT k, decl_node paramList, decl_node returnType) -{ - return makeUnary (k, getExpList (paramList, 1), returnType); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeIntrinsicBinaryType - create an intrisic binary type. -*/ - -static decl_node makeIntrinsicBinaryType (decl_nodeT k, decl_node paramList, decl_node returnType) -{ - return makeBinary (k, getExpList (paramList, 1), getExpList (paramList, 2), returnType); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkIntrinsic - checks to see if the function call to, c, with - parameter list, n, is really an intrinic. If it - is an intrinic then an intrinic node is created - and returned. Otherwise NIL is returned. -*/ - -static decl_node checkIntrinsic (decl_node c, decl_node n) -{ - if (isAnyType (c)) - { - return makeCast (c, n); - } - else if (c == maxN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_max, n, NULL); - } - else if (c == minN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_min, n, NULL); - } - else if (c == haltN) - { - /* avoid dangling else. */ - return makeIntrinsicProc (decl_halt, expListLen (n), n); - } - else if (c == valN) - { - /* avoid dangling else. */ - return makeVal (n); - } - else if (c == adrN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_adr, n, addressN); - } - else if (c == sizeN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_size, n, cardinalN); - } - else if (c == tsizeN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_tsize, n, cardinalN); - } - else if (c == floatN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_float, n, realN); - } - else if (c == truncN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_trunc, n, integerN); - } - else if (c == ordN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_ord, n, cardinalN); - } - else if (c == chrN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_chr, n, charN); - } - else if (c == capN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_cap, n, charN); - } - else if (c == absN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_abs, n, NULL); - } - else if (c == imN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_im, n, NULL); - } - else if (c == reN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_re, n, NULL); - } - else if (c == cmplxN) - { - /* avoid dangling else. */ - return makeIntrinsicBinaryType (decl_cmplx, n, NULL); - } - else if (c == highN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_high, n, cardinalN); - } - else if (c == incN) - { - /* avoid dangling else. */ - return makeIntrinsicProc (decl_inc, expListLen (n), n); - } - else if (c == decN) - { - /* avoid dangling else. */ - return makeIntrinsicProc (decl_dec, expListLen (n), n); - } - else if (c == inclN) - { - /* avoid dangling else. */ - return makeIntrinsicProc (decl_incl, expListLen (n), n); - } - else if (c == exclN) - { - /* avoid dangling else. */ - return makeIntrinsicProc (decl_excl, expListLen (n), n); - } - else if (c == newN) - { - /* avoid dangling else. */ - return makeIntrinsicProc (decl_new, 1, n); - } - else if (c == disposeN) - { - /* avoid dangling else. */ - return makeIntrinsicProc (decl_dispose, 1, n); - } - else if (c == lengthN) - { - /* avoid dangling else. */ - return makeIntrinsicUnaryType (decl_length, n, cardinalN); - } - else if (c == throwN) - { - /* avoid dangling else. */ - keyc_useThrow (); - return makeIntrinsicProc (decl_throw, 1, n); - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkCHeaders - check to see if the function is a C system function and - requires a header file included. -*/ - -static void checkCHeaders (decl_node c) -{ - nameKey_Name name; - decl_node s; - - if (decl_isProcedure (c)) - { - s = decl_getScope (c); - if ((decl_getSymName (s)) == (nameKey_makeKey ((const char *) "libc", 4))) - { - name = decl_getSymName (c); - if ((((name == (nameKey_makeKey ((const char *) "read", 4))) || (name == (nameKey_makeKey ((const char *) "write", 5)))) || (name == (nameKey_makeKey ((const char *) "open", 4)))) || (name == (nameKey_makeKey ((const char *) "close", 5)))) - { - keyc_useUnistd (); - } - } - } -} - - -/* - isFuncCall - returns TRUE if, n, is a function/procedure call. -*/ - -static unsigned int isFuncCall (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_funccall; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putTypeInternal - marks type, des, as being an internally generated type. -*/ - -static void putTypeInternal (decl_node des) -{ - mcDebug_assert (des != NULL); - mcDebug_assert (decl_isType (des)); - des->typeF.isInternal = TRUE; -} - - -/* - isTypeInternal - returns TRUE if type, n, is internal. -*/ - -static unsigned int isTypeInternal (decl_node n) -{ - mcDebug_assert (n != NULL); - mcDebug_assert (decl_isType (n)); - return n->typeF.isInternal; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - lookupBase - return node named n from the base symbol scope. -*/ - -static decl_node lookupBase (nameKey_Name n) -{ - decl_node m; - - m = static_cast (symbolKey_getSymKey (baseSymbols, n)); - if (m == procN) - { - keyc_useProc (); - } - else if (((m == complexN) || (m == longcomplexN)) || (m == shortcomplexN)) - { - /* avoid dangling else. */ - keyc_useComplex (); - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dumpScopes - display the names of all the scopes stacked. -*/ - -static void dumpScopes (void) -{ - unsigned int h; - decl_node s; - - h = Indexing_HighIndice (scopeStack); - libc_printf ((const char *) "total scopes stacked %d\\n", 25, h); - while (h >= 1) - { - s = static_cast (Indexing_GetIndice (scopeStack, h)); - out2 ((const char *) " scope [%d] is %s\\n", 19, h, s); - h -= 1; - } -} - - -/* - out0 - write string a to StdOut. -*/ - -static void out0 (const char *a_, unsigned int _a_high) -{ - DynamicStrings_String m; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) a, _a_high)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); -} - - -/* - out1 - write string a to StdOut using format specifier a. -*/ - -static void out1 (const char *a_, unsigned int _a_high, decl_node s) -{ - DynamicStrings_String m; - unsigned int d; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - m = getFQstring (s); - if (DynamicStrings_EqualArray (m, (const char *) "", 0)) - { - d = (unsigned int ) ((long unsigned int ) (s)); - m = DynamicStrings_KillString (m); - m = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "[%d]", 4), (const unsigned char *) &d, (sizeof (d)-1)); - } - m = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &m, (sizeof (m)-1)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); -} - - -/* - out2 - write string a to StdOut using format specifier a. -*/ - -static void out2 (const char *a_, unsigned int _a_high, unsigned int c, decl_node s) -{ - DynamicStrings_String m; - DynamicStrings_String m1; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - m1 = getString (s); - m = FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) &m1, (sizeof (m1)-1)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); - m1 = DynamicStrings_KillString (m1); -} - - -/* - out3 - write string a to StdOut using format specifier a. -*/ - -static void out3 (const char *a_, unsigned int _a_high, unsigned int l, nameKey_Name n, decl_node s) -{ - DynamicStrings_String m; - DynamicStrings_String m1; - DynamicStrings_String m2; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - m1 = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); - m2 = getString (s); - m = FormatStrings_Sprintf3 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &l, (sizeof (l)-1), (const unsigned char *) &m1, (sizeof (m1)-1), (const unsigned char *) &m2, (sizeof (m2)-1)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); - m1 = DynamicStrings_KillString (m1); - m2 = DynamicStrings_KillString (m2); -} - - -/* - isUnary - returns TRUE if, n, is an unary node. -*/ - -static unsigned int isUnary (decl_node n) -{ - mcDebug_assert (n != NULL); - switch (n->kind) - { - case decl_length: - case decl_re: - case decl_im: - case decl_deref: - case decl_high: - case decl_chr: - case decl_cap: - case decl_abs: - case decl_ord: - case decl_float: - case decl_trunc: - case decl_constexp: - case decl_not: - case decl_neg: - case decl_adr: - case decl_size: - case decl_tsize: - case decl_min: - case decl_max: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isBinary - returns TRUE if, n, is an binary node. -*/ - -static unsigned int isBinary (decl_node n) -{ - mcDebug_assert (n != NULL); - switch (n->kind) - { - case decl_cmplx: - case decl_and: - case decl_or: - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - case decl_val: - case decl_cast: - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - case decl_in: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeUnary - create a unary expression node with, e, as the argument - and res as the return type. -*/ - -static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res) -{ - decl_node n; - - if (k == decl_plus) - { - return e; - } - else - { - n = newNode (k); - switch (n->kind) - { - case decl_min: - case decl_max: - case decl_throw: - case decl_re: - case decl_im: - case decl_deref: - case decl_high: - case decl_chr: - case decl_cap: - case decl_abs: - case decl_ord: - case decl_float: - case decl_trunc: - case decl_length: - case decl_constexp: - case decl_not: - case decl_neg: - case decl_adr: - case decl_size: - case decl_tsize: - n->unaryF.arg = e; - n->unaryF.resultType = res; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLeafString - returns TRUE if n is a leaf node which is a string constant. -*/ - -static unsigned int isLeafString (decl_node n) -{ - return ((isString (n)) || ((decl_isLiteral (n)) && ((decl_getType (n)) == charN))) || ((decl_isConst (n)) && ((getExprType (n)) == charN)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getLiteralStringContents - return the contents of a literal node as a string. -*/ - -static DynamicStrings_String getLiteralStringContents (decl_node n) -{ - DynamicStrings_String number; - DynamicStrings_String content; - DynamicStrings_String s; - - mcDebug_assert (n->kind == decl_literal); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n->literalF.name)); - content = NULL; - if (n->literalF.type == charN) - { - if ((DynamicStrings_char (s, -1)) == 'C') - { - if ((DynamicStrings_Length (s)) > 1) - { - number = DynamicStrings_Slice (s, 0, -1); - content = DynamicStrings_InitStringChar ((char ) (StringConvert_ostoc (number))); - number = DynamicStrings_KillString (number); - } - else - { - content = DynamicStrings_InitStringChar ('C'); - } - } - else - { - content = DynamicStrings_Dup (s); - } - } - else - { - mcMetaError_metaError1 ((const char *) "cannot obtain string contents from {%1k}", 40, (const unsigned char *) &n->literalF.name, (sizeof (n->literalF.name)-1)); - } - s = DynamicStrings_KillString (s); - return content; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getStringContents - return the string contents of a constant, literal, - string or a constexp node. -*/ - -static DynamicStrings_String getStringContents (decl_node n) -{ - if (decl_isConst (n)) - { - return getStringContents (n->constF.value); - } - else if (decl_isLiteral (n)) - { - /* avoid dangling else. */ - return getLiteralStringContents (n); - } - else if (isString (n)) - { - /* avoid dangling else. */ - return getString (n); - } - else if (isConstExp (n)) - { - /* avoid dangling else. */ - return getStringContents (n->unaryF.arg); - } - M2RTS_HALT (-1); - __builtin_unreachable (); - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - addNames - -*/ - -static nameKey_Name addNames (decl_node a, decl_node b) -{ - DynamicStrings_String sa; - DynamicStrings_String sb; - nameKey_Name n; - - sa = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (a))); - sb = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (b))); - sa = DynamicStrings_ConCat (sa, sb); - n = nameKey_makekey (DynamicStrings_string (sa)); - sa = DynamicStrings_KillString (sa); - sb = DynamicStrings_KillString (sb); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - resolveString - -*/ - -static decl_node resolveString (decl_node n) -{ - while ((decl_isConst (n)) || (isConstExp (n))) - { - if (decl_isConst (n)) - { - n = n->constF.value; - } - else - { - n = n->unaryF.arg; - } - } - if (n->kind == decl_plus) - { - n = decl_makeString (addNames (resolveString (n->binaryF.left), resolveString (n->binaryF.right))); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - foldBinary - -*/ - -static decl_node foldBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res) -{ - decl_node n; - DynamicStrings_String ls; - DynamicStrings_String rs; - - n = NULL; - if (((k == decl_plus) && (isLeafString (l))) && (isLeafString (r))) - { - ls = getStringContents (l); - rs = getStringContents (r); - ls = DynamicStrings_Add (ls, rs); - n = decl_makeString (nameKey_makekey (DynamicStrings_string (ls))); - ls = DynamicStrings_KillString (ls); - rs = DynamicStrings_KillString (rs); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeBinary - create a binary node with left/right/result type: l, r and resultType. -*/ - -static decl_node makeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node resultType) -{ - decl_node n; - - n = foldBinary (k, l, r, resultType); - if (n == NULL) - { - n = doMakeBinary (k, l, r, resultType); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doMakeBinary - returns a binary node containing left/right/result values - l, r, res, with a node operator, k. -*/ - -static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res) -{ - decl_node n; - - n = newNode (k); - switch (n->kind) - { - case decl_cmplx: - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - case decl_and: - case decl_or: - case decl_cast: - case decl_val: - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - case decl_in: - n->binaryF.left = l; - n->binaryF.right = r; - n->binaryF.resultType = res; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doMakeComponentRef - -*/ - -static decl_node doMakeComponentRef (decl_node rec, decl_node field) -{ - decl_node n; - - n = newNode (decl_componentref); - n->componentrefF.rec = rec; - n->componentrefF.field = field; - n->componentrefF.resultType = decl_getType (field); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isComponentRef - -*/ - -static unsigned int isComponentRef (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_componentref; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isArrayRef - returns TRUE if the node was an arrayref. -*/ - -static unsigned int isArrayRef (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_arrayref; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isDeref - returns TRUE if, n, is a deref node. -*/ - -static unsigned int isDeref (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_deref; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeBase - create a base type or constant. - It only supports the base types and constants - enumerated below. -*/ - -static decl_node makeBase (decl_nodeT k) -{ - decl_node n; - - n = newNode (k); - switch (k) - { - case decl_new: - case decl_dispose: - case decl_length: - case decl_inc: - case decl_dec: - case decl_incl: - case decl_excl: - case decl_nil: - case decl_true: - case decl_false: - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_boolean: - case decl_proc: - case decl_ztype: - case decl_rtype: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - case decl_adr: - case decl_chr: - case decl_cap: - case decl_abs: - case decl_float: - case decl_trunc: - case decl_ord: - case decl_high: - case decl_throw: - case decl_re: - case decl_im: - case decl_cmplx: - case decl_size: - case decl_tsize: - case decl_val: - case decl_min: - case decl_max: - break; - - - default: - M2RTS_HALT (-1); /* legal kind. */ - __builtin_unreachable (); - break; - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isOrdinal - returns TRUE if, n, is an ordinal type. -*/ - -static unsigned int isOrdinal (decl_node n) -{ - switch (n->kind) - { - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - case decl_char: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_bitset: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - mixTypes - -*/ - -static decl_node mixTypes (decl_node a, decl_node b) -{ - if ((a == addressN) || (b == addressN)) - { - return addressN; - } - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doSetExprType - -*/ - -static decl_node doSetExprType (decl_node *t, decl_node n) -{ - if ((*t) == NULL) - { - (*t) = n; - } - return (*t); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getMaxMinType - -*/ - -static decl_node getMaxMinType (decl_node n) -{ - if ((decl_isVar (n)) || (decl_isConst (n))) - { - return decl_getType (n); - } - else if (isConstExp (n)) - { - /* avoid dangling else. */ - n = getExprType (n->unaryF.arg); - if (n == bitsetN) - { - return ztypeN; - } - else - { - return n; - } - } - else - { - /* avoid dangling else. */ - return n; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doGetFuncType - -*/ - -static decl_node doGetFuncType (decl_node n) -{ - mcDebug_assert (isFuncCall (n)); - return doSetExprType (&n->funccallF.type, decl_getType (n->funccallF.function)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doGetExprType - works out the type which is associated with node, n. -*/ - -static decl_node doGetExprType (decl_node n) -{ - switch (n->kind) - { - case decl_max: - case decl_min: - return getMaxMinType (n->unaryF.arg); - break; - - case decl_cast: - case decl_val: - return doSetExprType (&n->binaryF.resultType, n->binaryF.left); - break; - - case decl_halt: - case decl_new: - case decl_dispose: - return NULL; - break; - - case decl_inc: - case decl_dec: - case decl_incl: - case decl_excl: - return NULL; - break; - - case decl_nil: - return addressN; - break; - - case decl_true: - case decl_false: - return booleanN; - break; - - case decl_address: - return n; - break; - - case decl_loc: - return n; - break; - - case decl_byte: - return n; - break; - - case decl_word: - return n; - break; - - case decl_csizet: - return n; - break; - - case decl_cssizet: - return n; - break; - - case decl_boolean: - /* base types. */ - return n; - break; - - case decl_proc: - return n; - break; - - case decl_char: - return n; - break; - - case decl_cardinal: - return n; - break; - - case decl_longcard: - return n; - break; - - case decl_shortcard: - return n; - break; - - case decl_integer: - return n; - break; - - case decl_longint: - return n; - break; - - case decl_shortint: - return n; - break; - - case decl_real: - return n; - break; - - case decl_longreal: - return n; - break; - - case decl_shortreal: - return n; - break; - - case decl_bitset: - return n; - break; - - case decl_ztype: - return n; - break; - - case decl_rtype: - return n; - break; - - case decl_complex: - return n; - break; - - case decl_longcomplex: - return n; - break; - - case decl_shortcomplex: - return n; - break; - - case decl_type: - /* language features and compound type attributes. */ - return n->typeF.type; - break; - - case decl_record: - return n; - break; - - case decl_varient: - return n; - break; - - case decl_var: - return n->varF.type; - break; - - case decl_enumeration: - return n; - break; - - case decl_subrange: - return n->subrangeF.type; - break; - - case decl_array: - return n->arrayF.type; - break; - - case decl_string: - return charN; - break; - - case decl_const: - return doSetExprType (&n->constF.type, getExprType (n->constF.value)); - break; - - case decl_literal: - return n->literalF.type; - break; - - case decl_varparam: - return n->varparamF.type; - break; - - case decl_param: - return n->paramF.type; - break; - - case decl_optarg: - return n->optargF.type; - break; - - case decl_pointer: - return n->pointerF.type; - break; - - case decl_recordfield: - return n->recordfieldF.type; - break; - - case decl_varientfield: - return n; - break; - - case decl_enumerationfield: - return n->enumerationfieldF.type; - break; - - case decl_set: - return n->setF.type; - break; - - case decl_proctype: - return n->proctypeF.returnType; - break; - - case decl_subscript: - return n->subscriptF.type; - break; - - case decl_procedure: - /* blocks. */ - return n->procedureF.returnType; - break; - - case decl_throw: - return NULL; - break; - - case decl_unreachable: - return NULL; - break; - - case decl_def: - case decl_imp: - case decl_module: - case decl_loop: - case decl_while: - case decl_for: - case decl_repeat: - case decl_if: - case decl_elsif: - case decl_assignment: - /* statements. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - /* expressions. */ - return doSetExprType (&n->binaryF.resultType, mixTypes (getExprType (n->binaryF.left), getExprType (n->binaryF.right))); - break; - - case decl_in: - case decl_and: - case decl_or: - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - return doSetExprType (&n->binaryF.resultType, booleanN); - break; - - case decl_cmplx: - return doSetExprType (&n->binaryF.resultType, complexN); - break; - - case decl_abs: - case decl_constexp: - case decl_deref: - case decl_neg: - return doSetExprType (&n->unaryF.resultType, getExprType (n->unaryF.arg)); - break; - - case decl_adr: - return doSetExprType (&n->unaryF.resultType, addressN); - break; - - case decl_size: - case decl_tsize: - return doSetExprType (&n->unaryF.resultType, cardinalN); - break; - - case decl_high: - case decl_ord: - return doSetExprType (&n->unaryF.resultType, cardinalN); - break; - - case decl_float: - return doSetExprType (&n->unaryF.resultType, realN); - break; - - case decl_trunc: - return doSetExprType (&n->unaryF.resultType, integerN); - break; - - case decl_chr: - return doSetExprType (&n->unaryF.resultType, charN); - break; - - case decl_cap: - return doSetExprType (&n->unaryF.resultType, charN); - break; - - case decl_not: - return doSetExprType (&n->unaryF.resultType, booleanN); - break; - - case decl_re: - return doSetExprType (&n->unaryF.resultType, realN); - break; - - case decl_im: - return doSetExprType (&n->unaryF.resultType, realN); - break; - - case decl_arrayref: - return n->arrayrefF.resultType; - break; - - case decl_componentref: - return n->componentrefF.resultType; - break; - - case decl_pointerref: - return n->pointerrefF.resultType; - break; - - case decl_funccall: - return doSetExprType (&n->funccallF.type, doGetFuncType (n)); - break; - - case decl_setvalue: - return n->setvalueF.type; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - M2RTS_HALT (-1); - __builtin_unreachable (); - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - getExprType - return the expression type. -*/ - -static decl_node getExprType (decl_node n) -{ - decl_node t; - - if (((isFuncCall (n)) && ((decl_getType (n)) != NULL)) && (decl_isProcType (decl_skipType (decl_getType (n))))) - { - return decl_getType (decl_skipType (decl_getType (n))); - } - t = decl_getType (n); - if (t == NULL) - { - t = doGetExprType (n); - } - return t; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openOutput - -*/ - -static void openOutput (void) -{ - DynamicStrings_String s; - - s = mcOptions_getOutputFile (); - if (DynamicStrings_EqualArray (s, (const char *) "-", 1)) - { - outputFile = FIO_StdOut; - } - else - { - outputFile = SFIO_OpenToWrite (s); - } - mcStream_setDest (outputFile); -} - - -/* - closeOutput - -*/ - -static void closeOutput (void) -{ - DynamicStrings_String s; - - s = mcOptions_getOutputFile (); - outputFile = mcStream_combine (); - if (! (DynamicStrings_EqualArray (s, (const char *) "-", 1))) - { - FIO_Close (outputFile); - } -} - - -/* - write - outputs a single char, ch. -*/ - -static void write_ (char ch) -{ - FIO_WriteChar (outputFile, ch); - FIO_FlushBuffer (outputFile); -} - - -/* - writeln - -*/ - -static void writeln (void) -{ - FIO_WriteLine (outputFile); - FIO_FlushBuffer (outputFile); -} - - -/* - doIncludeC - include header file for definition module, n. -*/ - -static void doIncludeC (decl_node n) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - if (mcOptions_getExtendedOpaque ()) - {} /* empty. */ - /* no include in this case. */ - else if (decl_isDef (n)) - { - /* avoid dangling else. */ - mcPretty_print (doP, (const char *) "# include \"", 13); - mcPretty_prints (doP, mcOptions_getHPrefix ()); - mcPretty_prints (doP, s); - mcPretty_print (doP, (const char *) ".h\"\\n", 5); - symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDoneDef}); - } - s = DynamicStrings_KillString (s); -} - - -/* - getSymScope - returns the scope where node, n, was declared. -*/ - -static decl_node getSymScope (decl_node n) -{ - switch (n->kind) - { - case decl_const: - return n->constF.scope; - break; - - case decl_type: - return n->typeF.scope; - break; - - case decl_var: - return n->varF.scope; - break; - - case decl_procedure: - return n->procedureF.scope; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - M2RTS_HALT (-1); - __builtin_unreachable (); - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - isQualifiedForced - should the node be written with a module prefix? -*/ - -static unsigned int isQualifiedForced (decl_node n) -{ - return forceQualified && (((((decl_isType (n)) || (decl_isRecord (n))) || (decl_isArray (n))) || (decl_isEnumeration (n))) || (decl_isEnumerationField (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getFQstring - -*/ - -static DynamicStrings_String getFQstring (decl_node n) -{ - DynamicStrings_String i; - DynamicStrings_String s; - - if ((decl_getScope (n)) == NULL) - { - return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - } - else if (isQualifiedForced (n)) - { - /* avoid dangling else. */ - i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n)))); - return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1)); - } - else if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ())) - { - /* avoid dangling else. */ - return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - } - else - { - /* avoid dangling else. */ - i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n)))); - return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getFQDstring - -*/ - -static DynamicStrings_String getFQDstring (decl_node n, unsigned int scopes) -{ - DynamicStrings_String i; - DynamicStrings_String s; - - if ((decl_getScope (n)) == NULL) - { - return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (getDName (n, scopes))); - } - else if (isQualifiedForced (n)) - { - /* avoid dangling else. */ - /* we assume a qualified name will never conflict. */ - i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n)))); - return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1)); - } - else if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ())) - { - /* avoid dangling else. */ - return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (getDName (n, scopes))); - } - else - { - /* avoid dangling else. */ - /* we assume a qualified name will never conflict. */ - i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n)))); - return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getString - returns the name as a string. -*/ - -static DynamicStrings_String getString (decl_node n) -{ - if ((decl_getSymName (n)) == nameKey_NulName) - { - return DynamicStrings_InitString ((const char *) "", 0); - } - else - { - return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doNone - call HALT. -*/ - -static void doNone (decl_node n) -{ - M2RTS_HALT (-1); - __builtin_unreachable (); -} - - -/* - doNothing - does nothing! -*/ - -static void doNothing (decl_node n) -{ -} - - -/* - doConstC - -*/ - -static void doConstC (decl_node n) -{ - if (! (alists_isItemInList (doneQ, reinterpret_cast (n)))) - { - mcPretty_print (doP, (const char *) "# define ", 11); - doFQNameC (doP, n); - mcPretty_setNeedSpace (doP); - doExprC (doP, n->constF.value); - mcPretty_print (doP, (const char *) "\\n", 2); - alists_includeItemIntoList (doneQ, reinterpret_cast (n)); - } -} - - -/* - needsParen - returns TRUE if expression, n, needs to be enclosed in (). -*/ - -static unsigned int needsParen (decl_node n) -{ - mcDebug_assert (n != NULL); - switch (n->kind) - { - case decl_nil: - case decl_true: - case decl_false: - return FALSE; - break; - - case decl_constexp: - return needsParen (n->unaryF.arg); - break; - - case decl_neg: - return needsParen (n->unaryF.arg); - break; - - case decl_not: - return needsParen (n->unaryF.arg); - break; - - case decl_adr: - case decl_size: - case decl_tsize: - case decl_ord: - case decl_float: - case decl_trunc: - case decl_chr: - case decl_cap: - case decl_high: - return FALSE; - break; - - case decl_deref: - return FALSE; - break; - - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - return TRUE; - break; - - case decl_componentref: - return FALSE; - break; - - case decl_pointerref: - return FALSE; - break; - - case decl_cast: - return TRUE; - break; - - case decl_val: - return TRUE; - break; - - case decl_abs: - return FALSE; - break; - - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - case decl_in: - return TRUE; - break; - - case decl_literal: - case decl_const: - case decl_enumerationfield: - case decl_string: - return FALSE; - break; - - case decl_max: - return TRUE; - break; - - case decl_min: - return TRUE; - break; - - case decl_var: - return FALSE; - break; - - case decl_arrayref: - return FALSE; - break; - - case decl_and: - case decl_or: - return TRUE; - break; - - case decl_funccall: - return TRUE; - break; - - case decl_recordfield: - return FALSE; - break; - - case decl_loc: - case decl_byte: - case decl_word: - case decl_type: - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - case decl_bitset: - case decl_boolean: - case decl_proc: - return FALSE; - break; - - case decl_setvalue: - return FALSE; - break; - - case decl_address: - return TRUE; - break; - - case decl_procedure: - return FALSE; - break; - - case decl_length: - case decl_cmplx: - case decl_re: - case decl_im: - return TRUE; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doUnary - -*/ - -static void doUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr, decl_node type, unsigned int l, unsigned int r) -{ - char op[_op_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (op, op_, _op_high+1); - - if (l) - { - mcPretty_setNeedSpace (p); - } - mcPretty_print (p, (const char *) op, _op_high); - if (r) - { - mcPretty_setNeedSpace (p); - } - if (needsParen (expr)) - { - outText (p, (const char *) "(", 1); - doExprC (p, expr); - outText (p, (const char *) ")", 1); - } - else - { - doExprC (p, expr); - } -} - - -/* - doSetSub - perform l & (~ r) -*/ - -static void doSetSub (mcPretty_pretty p, decl_node left, decl_node right) -{ - if (needsParen (left)) - { - outText (p, (const char *) "(", 1); - doExprC (p, left); - outText (p, (const char *) ")", 1); - } - else - { - doExprC (p, left); - } - mcPretty_setNeedSpace (p); - outText (p, (const char *) "&", 1); - mcPretty_setNeedSpace (p); - if (needsParen (right)) - { - outText (p, (const char *) "(~(", 3); - doExprC (p, right); - outText (p, (const char *) "))", 2); - } - else - { - outText (p, (const char *) "(~", 2); - doExprC (p, right); - outText (p, (const char *) ")", 1); - } -} - - -/* - doPolyBinary - -*/ - -static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl_node right, unsigned int l, unsigned int r) -{ - decl_node lt; - decl_node rt; - - lt = decl_skipType (getExprType (left)); - rt = decl_skipType (getExprType (right)); - if (((lt != NULL) && ((decl_isSet (lt)) || (isBitset (lt)))) || ((rt != NULL) && ((decl_isSet (rt)) || (isBitset (rt))))) - { - switch (op) - { - case decl_plus: - doBinary (p, (const char *) "|", 1, left, right, l, r, FALSE); - break; - - case decl_sub: - doSetSub (p, left, right); - break; - - case decl_mult: - doBinary (p, (const char *) "&", 1, left, right, l, r, FALSE); - break; - - case decl_divide: - doBinary (p, (const char *) "^", 1, left, right, l, r, FALSE); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - } - else - { - switch (op) - { - case decl_plus: - doBinary (p, (const char *) "+", 1, left, right, l, r, FALSE); - break; - - case decl_sub: - doBinary (p, (const char *) "-", 1, left, right, l, r, FALSE); - break; - - case decl_mult: - doBinary (p, (const char *) "*", 1, left, right, l, r, FALSE); - break; - - case decl_divide: - doBinary (p, (const char *) "/", 1, left, right, l, r, FALSE); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - } -} - - -/* - doBinary - -*/ - -static void doBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r, unsigned int unpackProc) -{ - char op[_op_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (op, op_, _op_high+1); - - if (needsParen (left)) - { - outText (p, (const char *) "(", 1); - doExprCup (p, left, unpackProc); - outText (p, (const char *) ")", 1); - } - else - { - doExprCup (p, left, unpackProc); - } - if (l) - { - mcPretty_setNeedSpace (p); - } - outText (p, (const char *) op, _op_high); - if (r) - { - mcPretty_setNeedSpace (p); - } - if (needsParen (right)) - { - outText (p, (const char *) "(", 1); - doExprCup (p, right, unpackProc); - outText (p, (const char *) ")", 1); - } - else - { - doExprCup (p, right, unpackProc); - } -} - - -/* - doPostUnary - -*/ - -static void doPostUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr) -{ - char op[_op_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (op, op_, _op_high+1); - - doExprC (p, expr); - outText (p, (const char *) op, _op_high); -} - - -/* - doDeRefC - -*/ - -static void doDeRefC (mcPretty_pretty p, decl_node expr) -{ - outText (p, (const char *) "(*", 2); - doExprC (p, expr); - outText (p, (const char *) ")", 1); -} - - -/* - doGetLastOp - returns, a, if b is a terminal otherwise walk right. -*/ - -static decl_node doGetLastOp (decl_node a, decl_node b) -{ - switch (b->kind) - { - case decl_nil: - return a; - break; - - case decl_true: - return a; - break; - - case decl_false: - return a; - break; - - case decl_constexp: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_neg: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_not: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_adr: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_size: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_tsize: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_ord: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_float: - case decl_trunc: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_chr: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_cap: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_high: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_deref: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_re: - case decl_im: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_equal: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_notequal: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_less: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_greater: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_greequal: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_lessequal: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_componentref: - return doGetLastOp (b, b->componentrefF.field); - break; - - case decl_pointerref: - return doGetLastOp (b, b->pointerrefF.field); - break; - - case decl_cast: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_val: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_plus: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_sub: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_div: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_mod: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_mult: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_divide: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_in: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_and: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_or: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_cmplx: - return doGetLastOp (b, b->binaryF.right); - break; - - case decl_literal: - return a; - break; - - case decl_const: - return a; - break; - - case decl_enumerationfield: - return a; - break; - - case decl_string: - return a; - break; - - case decl_max: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_min: - return doGetLastOp (b, b->unaryF.arg); - break; - - case decl_var: - return a; - break; - - case decl_arrayref: - return a; - break; - - case decl_funccall: - return a; - break; - - case decl_procedure: - return a; - break; - - case decl_recordfield: - return a; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doComponentRefC - -*/ - -static void doComponentRefC (mcPretty_pretty p, decl_node l, decl_node r) -{ - doExprC (p, l); - outText (p, (const char *) ".", 1); - doExprC (p, r); -} - - -/* - doPointerRefC - -*/ - -static void doPointerRefC (mcPretty_pretty p, decl_node l, decl_node r) -{ - doExprC (p, l); - outText (p, (const char *) "->", 2); - doExprC (p, r); -} - - -/* - doPreBinary - -*/ - -static void doPreBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r) -{ - char op[_op_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (op, op_, _op_high+1); - - if (l) - { - mcPretty_setNeedSpace (p); - } - outText (p, (const char *) op, _op_high); - if (r) - { - mcPretty_setNeedSpace (p); - } - outText (p, (const char *) "(", 1); - doExprC (p, left); - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - doExprC (p, right); - outText (p, (const char *) ")", 1); -} - - -/* - doConstExpr - -*/ - -static void doConstExpr (mcPretty_pretty p, decl_node n) -{ - doFQNameC (p, n); -} - - -/* - doEnumerationField - -*/ - -static void doEnumerationField (mcPretty_pretty p, decl_node n) -{ - doFQDNameC (p, n, FALSE); -} - - -/* - isZero - returns TRUE if node, n, is zero. -*/ - -static unsigned int isZero (decl_node n) -{ - if (isConstExp (n)) - { - return isZero (n->unaryF.arg); - } - return (decl_getSymName (n)) == (nameKey_makeKey ((const char *) "0", 1)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doArrayRef - -*/ - -static void doArrayRef (mcPretty_pretty p, decl_node n) -{ - decl_node t; - unsigned int i; - unsigned int c; - - mcDebug_assert (n != NULL); - mcDebug_assert (isArrayRef (n)); - t = decl_skipType (decl_getType (n->arrayrefF.array)); - if (decl_isUnbounded (t)) - { - outTextN (p, decl_getSymName (n->arrayrefF.array)); - } - else - { - doExprC (p, n->arrayrefF.array); - mcDebug_assert (decl_isArray (t)); - outText (p, (const char *) ".array", 6); - } - outText (p, (const char *) "[", 1); - i = 1; - c = expListLen (n->arrayrefF.index); - while (i <= c) - { - doExprC (p, getExpList (n->arrayrefF.index, i)); - if (decl_isUnbounded (t)) - { - mcDebug_assert (c == 1); - } - else - { - doSubtractC (p, getMin (t->arrayF.subr)); - if (i < c) - { - mcDebug_assert (decl_isArray (t)); - outText (p, (const char *) "].array[", 8); - t = decl_skipType (decl_getType (t)); - } - } - i += 1; - } - outText (p, (const char *) "]", 1); -} - - -/* - doProcedure - -*/ - -static void doProcedure (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (decl_isProcedure (n)); - doFQDNameC (p, n, TRUE); -} - - -/* - doRecordfield - -*/ - -static void doRecordfield (mcPretty_pretty p, decl_node n) -{ - doDNameC (p, n, FALSE); -} - - -/* - doCastC - -*/ - -static void doCastC (mcPretty_pretty p, decl_node t, decl_node e) -{ - decl_node et; - - outText (p, (const char *) "(", 1); - doTypeNameC (p, t); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - et = decl_skipType (decl_getType (e)); - if (((et != NULL) && (isAProcType (et))) && (isAProcType (decl_skipType (t)))) - { - outText (p, (const char *) "{(", 2); - doFQNameC (p, t); - outText (p, (const char *) "_t)", 3); - mcPretty_setNeedSpace (p); - doExprC (p, e); - outText (p, (const char *) ".proc}", 6); - } - else - { - outText (p, (const char *) "(", 1); - doExprC (p, e); - outText (p, (const char *) ")", 1); - } -} - - -/* - doSetValueC - -*/ - -static void doSetValueC (mcPretty_pretty p, decl_node n) -{ - decl_node lo; - unsigned int i; - unsigned int h; - - mcDebug_assert (decl_isSetValue (n)); - lo = getSetLow (n); - if (n->setvalueF.type != NULL) - { - outText (p, (const char *) "(", 1); - doTypeNameC (p, n->setvalueF.type); - mcPretty_noSpace (p); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - } - if ((Indexing_HighIndice (n->setvalueF.values)) == 0) - { - outText (p, (const char *) "0", 1); - } - else - { - i = Indexing_LowIndice (n->setvalueF.values); - h = Indexing_HighIndice (n->setvalueF.values); - outText (p, (const char *) "(", 1); - while (i <= h) - { - outText (p, (const char *) "(1", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "<<", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, reinterpret_cast (Indexing_GetIndice (n->setvalueF.values, i))); - doSubtractC (p, lo); - outText (p, (const char *) ")", 1); - outText (p, (const char *) ")", 1); - if (i < h) - { - mcPretty_setNeedSpace (p); - outText (p, (const char *) "|", 1); - mcPretty_setNeedSpace (p); - } - i += 1; - } - outText (p, (const char *) ")", 1); - } -} - - -/* - getSetLow - returns the low value of the set type from - expression, n. -*/ - -static decl_node getSetLow (decl_node n) -{ - decl_node type; - - if ((decl_getType (n)) == NULL) - { - return decl_makeLiteralInt (nameKey_makeKey ((const char *) "0", 1)); - } - else - { - type = decl_skipType (decl_getType (n)); - if (decl_isSet (type)) - { - return getMin (decl_skipType (decl_getType (type))); - } - else - { - return decl_makeLiteralInt (nameKey_makeKey ((const char *) "0", 1)); - } - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doInC - performs (((1 << (l)) & (r)) != 0) -*/ - -static void doInC (mcPretty_pretty p, decl_node l, decl_node r) -{ - decl_node lo; - - lo = getSetLow (r); - outText (p, (const char *) "(((1", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "<<", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, l); - doSubtractC (p, lo); - outText (p, (const char *) "))", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "&", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, r); - outText (p, (const char *) "))", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "!=", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "0)", 2); -} - - -/* - doThrowC - -*/ - -static void doThrowC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isIntrinsic (n)); - outText (p, (const char *) "throw", 5); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - if ((expListLen (n->intrinsicF.args)) == 1) - { - doExprC (p, getExpList (n->intrinsicF.args, 1)); - } - outText (p, (const char *) ")", 1); -} - - -/* - doUnreachableC - -*/ - -static void doUnreachableC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isIntrinsic (n)); - outText (p, (const char *) "__builtin_unreachable", 21); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - mcDebug_assert ((expListLen (n->intrinsicF.args)) == 0); - outText (p, (const char *) ")", 1); -} - - -/* - outNull - -*/ - -static void outNull (mcPretty_pretty p) -{ - keyc_useNull (); - outText (p, (const char *) "NULL", 4); -} - - -/* - outTrue - -*/ - -static void outTrue (mcPretty_pretty p) -{ - keyc_useTrue (); - outText (p, (const char *) "TRUE", 4); -} - - -/* - outFalse - -*/ - -static void outFalse (mcPretty_pretty p) -{ - keyc_useFalse (); - outText (p, (const char *) "FALSE", 5); -} - - -/* - doExprC - -*/ - -static void doExprC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (n != NULL); - t = getExprType (n); - switch (n->kind) - { - case decl_nil: - outNull (p); - break; - - case decl_true: - outTrue (p); - break; - - case decl_false: - outFalse (p); - break; - - case decl_constexp: - doUnary (p, (const char *) "", 0, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE); - break; - - case decl_neg: - doUnary (p, (const char *) "-", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE); - break; - - case decl_not: - doUnary (p, (const char *) "!", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, TRUE); - break; - - case decl_val: - doValC (p, n); - break; - - case decl_adr: - doAdrC (p, n); - break; - - case decl_size: - case decl_tsize: - doSizeC (p, n); - break; - - case decl_float: - doConvertC (p, n, (const char *) "(double)", 8); - break; - - case decl_trunc: - doConvertC (p, n, (const char *) "(int)", 5); - break; - - case decl_ord: - doConvertC (p, n, (const char *) "(unsigned int)", 14); - break; - - case decl_chr: - doConvertC (p, n, (const char *) "(char)", 6); - break; - - case decl_cap: - doCapC (p, n); - break; - - case decl_abs: - doAbsC (p, n); - break; - - case decl_high: - doFuncHighC (p, n->unaryF.arg); - break; - - case decl_length: - doLengthC (p, n); - break; - - case decl_min: - doMinC (p, n); - break; - - case decl_max: - doMaxC (p, n); - break; - - case decl_throw: - doThrowC (p, n); - break; - - case decl_unreachable: - doUnreachableC (p, n); - break; - - case decl_re: - doReC (p, n); - break; - - case decl_im: - doImC (p, n); - break; - - case decl_cmplx: - doCmplx (p, n); - break; - - case decl_deref: - doDeRefC (p, n->unaryF.arg); - break; - - case decl_equal: - doBinary (p, (const char *) "==", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, TRUE); - break; - - case decl_notequal: - doBinary (p, (const char *) "!=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, TRUE); - break; - - case decl_less: - doBinary (p, (const char *) "<", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_greater: - doBinary (p, (const char *) ">", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_greequal: - doBinary (p, (const char *) ">=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_lessequal: - doBinary (p, (const char *) "<=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_componentref: - doComponentRefC (p, n->componentrefF.rec, n->componentrefF.field); - break; - - case decl_pointerref: - doPointerRefC (p, n->pointerrefF.ptr, n->pointerrefF.field); - break; - - case decl_cast: - doCastC (p, n->binaryF.left, n->binaryF.right); - break; - - case decl_plus: - doPolyBinary (p, decl_plus, n->binaryF.left, n->binaryF.right, FALSE, FALSE); - break; - - case decl_sub: - doPolyBinary (p, decl_sub, n->binaryF.left, n->binaryF.right, FALSE, FALSE); - break; - - case decl_div: - doBinary (p, (const char *) "/", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_mod: - doBinary (p, (const char *) "%", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_mult: - doPolyBinary (p, decl_mult, n->binaryF.left, n->binaryF.right, FALSE, FALSE); - break; - - case decl_divide: - doPolyBinary (p, decl_divide, n->binaryF.left, n->binaryF.right, FALSE, FALSE); - break; - - case decl_in: - doInC (p, n->binaryF.left, n->binaryF.right); - break; - - case decl_and: - doBinary (p, (const char *) "&&", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_or: - doBinary (p, (const char *) "||", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_literal: - doLiteralC (p, n); - break; - - case decl_const: - doConstExpr (p, n); - break; - - case decl_enumerationfield: - doEnumerationField (p, n); - break; - - case decl_string: - doStringC (p, n); - break; - - case decl_var: - doVar (p, n); - break; - - case decl_arrayref: - doArrayRef (p, n); - break; - - case decl_funccall: - doFuncExprC (p, n); - break; - - case decl_procedure: - doProcedure (p, n); - break; - - case decl_recordfield: - doRecordfield (p, n); - break; - - case decl_setvalue: - doSetValueC (p, n); - break; - - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_boolean: - case decl_proc: - doBaseC (p, n); - break; - - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - doSystemC (p, n); - break; - - case decl_type: - doTypeNameC (p, n); - break; - - case decl_pointer: - doTypeNameC (p, n); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - doExprCup - -*/ - -static void doExprCup (mcPretty_pretty p, decl_node n, unsigned int unpackProc) -{ - decl_node t; - - doExprC (p, n); - if (unpackProc) - { - t = decl_skipType (getExprType (n)); - if ((t != NULL) && (isAProcType (t))) - { - outText (p, (const char *) ".proc", 5); - } - } -} - - -/* - doExprM2 - -*/ - -static void doExprM2 (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (n != NULL); - switch (n->kind) - { - case decl_nil: - outText (p, (const char *) "NIL", 3); - break; - - case decl_true: - outText (p, (const char *) "TRUE", 4); - break; - - case decl_false: - outText (p, (const char *) "FALSE", 5); - break; - - case decl_constexp: - doUnary (p, (const char *) "", 0, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE); - break; - - case decl_neg: - doUnary (p, (const char *) "-", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE); - break; - - case decl_not: - doUnary (p, (const char *) "NOT", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_adr: - doUnary (p, (const char *) "ADR", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_size: - doUnary (p, (const char *) "SIZE", 4, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_tsize: - doUnary (p, (const char *) "TSIZE", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_float: - doUnary (p, (const char *) "FLOAT", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_trunc: - doUnary (p, (const char *) "TRUNC", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_ord: - doUnary (p, (const char *) "ORD", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_chr: - doUnary (p, (const char *) "CHR", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_cap: - doUnary (p, (const char *) "CAP", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_high: - doUnary (p, (const char *) "HIGH", 4, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_re: - doUnary (p, (const char *) "RE", 2, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_im: - doUnary (p, (const char *) "IM", 2, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_deref: - doPostUnary (p, (const char *) "^", 1, n->unaryF.arg); - break; - - case decl_equal: - doBinary (p, (const char *) "=", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_notequal: - doBinary (p, (const char *) "#", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_less: - doBinary (p, (const char *) "<", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_greater: - doBinary (p, (const char *) ">", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_greequal: - doBinary (p, (const char *) ">=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_lessequal: - doBinary (p, (const char *) "<=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_componentref: - doBinary (p, (const char *) ".", 1, n->componentrefF.rec, n->componentrefF.field, FALSE, FALSE, FALSE); - break; - - case decl_pointerref: - doBinary (p, (const char *) "^.", 2, n->pointerrefF.ptr, n->pointerrefF.field, FALSE, FALSE, FALSE); - break; - - case decl_cast: - doPreBinary (p, (const char *) "CAST", 4, n->binaryF.left, n->binaryF.right, TRUE, TRUE); - break; - - case decl_val: - doPreBinary (p, (const char *) "VAL", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE); - break; - - case decl_cmplx: - doPreBinary (p, (const char *) "CMPLX", 5, n->binaryF.left, n->binaryF.right, TRUE, TRUE); - break; - - case decl_plus: - doBinary (p, (const char *) "+", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE); - break; - - case decl_sub: - doBinary (p, (const char *) "-", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE); - break; - - case decl_div: - doBinary (p, (const char *) "DIV", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_mod: - doBinary (p, (const char *) "MOD", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE); - break; - - case decl_mult: - doBinary (p, (const char *) "*", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE); - break; - - case decl_divide: - doBinary (p, (const char *) "/", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE); - break; - - case decl_literal: - doLiteral (p, n); - break; - - case decl_const: - doConstExpr (p, n); - break; - - case decl_enumerationfield: - doEnumerationField (p, n); - break; - - case decl_string: - doString (p, n); - break; - - case decl_max: - doUnary (p, (const char *) "MAX", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_min: - doUnary (p, (const char *) "MIN", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE); - break; - - case decl_var: - doVar (p, n); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - doVar - -*/ - -static void doVar (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (decl_isVar (n)); - if (n->varF.isVarParameter) - { - outText (p, (const char *) "(*", 2); - doFQDNameC (p, n, TRUE); - outText (p, (const char *) ")", 1); - } - else - { - doFQDNameC (p, n, TRUE); - } -} - - -/* - doLiteralC - -*/ - -static void doLiteralC (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - mcDebug_assert (decl_isLiteral (n)); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - if (n->literalF.type == charN) - { - if ((DynamicStrings_char (s, -1)) == 'C') - { - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); - if ((DynamicStrings_char (s, 0)) != '0') - { - s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0", 1), DynamicStrings_Mark (s)); - } - } - outText (p, (const char *) "(char)", 6); - mcPretty_setNeedSpace (p); - } - else if ((DynamicStrings_char (s, -1)) == 'H') - { - /* avoid dangling else. */ - outText (p, (const char *) "0x", 2); - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); - } - else if ((DynamicStrings_char (s, -1)) == 'B') - { - /* avoid dangling else. */ - outText (p, (const char *) "0", 1); - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); - } - outTextS (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - doLiteral - -*/ - -static void doLiteral (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - mcDebug_assert (decl_isLiteral (n)); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - if (n->literalF.type == charN) - { - if ((DynamicStrings_char (s, -1)) == 'C') - { - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); - if ((DynamicStrings_char (s, 0)) != '0') - { - s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0", 1), DynamicStrings_Mark (s)); - } - } - outText (p, (const char *) "(char)", 6); - mcPretty_setNeedSpace (p); - } - outTextS (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - isString - returns TRUE if node, n, is a string. -*/ - -static unsigned int isString (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_string; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doString - -*/ - -static void doString (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - mcDebug_assert (isString (n)); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - outTextS (p, s); - s = DynamicStrings_KillString (s); - /* - IF DynamicStrings.Index (s, '"', 0)=-1 - THEN - outText (p, '"') ; - outTextS (p, s) ; - outText (p, '"') - ELSIF DynamicStrings.Index (s, "'", 0)=-1 - THEN - outText (p, '"') ; - outTextS (p, s) ; - outText (p, '"') - ELSE - metaError1 ('illegal string {%1k}', n) - END - */ - M2RTS_HALT (-1); - __builtin_unreachable (); -} - - -/* - replaceChar - replace every occurance of, ch, by, a and return modified string, s. -*/ - -static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, const char *a_, unsigned int _a_high) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = 0; - for (;;) - { - i = DynamicStrings_Index (s, ch, static_cast (i)); - if (i == 0) - { - s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) a, _a_high), DynamicStrings_Slice (s, 1, 0)); - i = StrLib_StrLen ((const char *) a, _a_high); - } - else if (i > 0) - { - /* avoid dangling else. */ - s = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_Slice (s, 0, i), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high))), DynamicStrings_Slice (s, i+1, 0)); - i += StrLib_StrLen ((const char *) a, _a_high); - } - else - { - /* avoid dangling else. */ - return s; - } - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - toCstring - translates string, n, into a C string - and returns the new String. -*/ - -static DynamicStrings_String toCstring (nameKey_Name n) -{ - DynamicStrings_String s; - - s = DynamicStrings_Slice (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)), 1, -1); - return replaceChar (replaceChar (s, '\\', (const char *) "\\\\", 2), '"', (const char *) "\\\"", 2); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - toCchar - -*/ - -static DynamicStrings_String toCchar (nameKey_Name n) -{ - DynamicStrings_String s; - - s = DynamicStrings_Slice (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)), 1, -1); - return replaceChar (replaceChar (s, '\\', (const char *) "\\\\", 2), '\'', (const char *) "\\'", 2); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - countChar - -*/ - -static unsigned int countChar (DynamicStrings_String s, char ch) -{ - int i; - unsigned int c; - - c = 0; - i = 0; - for (;;) - { - i = DynamicStrings_Index (s, ch, static_cast (i)); - if (i >= 0) - { - i += 1; - c += 1; - } - else - { - return c; - } - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - lenCstring - -*/ - -static unsigned int lenCstring (DynamicStrings_String s) -{ - return (DynamicStrings_Length (s))-(countChar (s, '\\')); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - outCstring - -*/ - -static void outCstring (mcPretty_pretty p, decl_node s, unsigned int aString) -{ - if (aString) - { - outText (p, (const char *) "\"", 1); - outRawS (p, s->stringF.cstring); - outText (p, (const char *) "\"", 1); - } - else - { - outText (p, (const char *) "'", 1); - outRawS (p, s->stringF.cchar); - outText (p, (const char *) "'", 1); - } -} - - -/* - doStringC - -*/ - -static void doStringC (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - mcDebug_assert (isString (n)); - /* - s := InitStringCharStar (keyToCharStar (getSymName (n))) ; - IF DynamicStrings.Length (s)>3 - THEN - IF DynamicStrings.Index (s, '"', 0)=-1 - THEN - s := DynamicStrings.Slice (s, 1, -1) ; - outText (p, '"') ; - outCstring (p, s) ; - outText (p, '"') - ELSIF DynamicStrings.Index (s, "'", 0)=-1 - THEN - s := DynamicStrings.Slice (s, 1, -1) ; - outText (p, '"') ; - outCstring (p, s) ; - outText (p, '"') - ELSE - metaError1 ('illegal string {%1k}', n) - END - ELSIF DynamicStrings.Length (s) = 3 - THEN - s := DynamicStrings.Slice (s, 1, -1) ; - outText (p, "'") ; - IF DynamicStrings.char (s, 0) = "'" - THEN - outText (p, "\'") - ELSIF DynamicStrings.char (s, 0) = "\" - THEN - outText (p, "\\") - ELSE - outTextS (p, s) - END ; - outText (p, "'") - ELSE - outText (p, "'\0'") - END ; - s := KillString (s) - */ - outCstring (p, n, ! n->stringF.isCharCompatible); -} - - -/* - isPunct - -*/ - -static unsigned int isPunct (char ch) -{ - return (((((((((ch == '.') || (ch == '(')) || (ch == ')')) || (ch == '^')) || (ch == ':')) || (ch == ';')) || (ch == '{')) || (ch == '}')) || (ch == ',')) || (ch == '*'); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isWhite - -*/ - -static unsigned int isWhite (char ch) -{ - return ((ch == ' ') || (ch == ASCII_tab)) || (ch == ASCII_lf); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - outText - -*/ - -static void outText (mcPretty_pretty p, const char *a_, unsigned int _a_high) -{ - DynamicStrings_String s; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - s = DynamicStrings_InitString ((const char *) a, _a_high); - outTextS (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - outRawS - -*/ - -static void outRawS (mcPretty_pretty p, DynamicStrings_String s) -{ - mcPretty_raw (p, s); -} - - -/* - outKm2 - -*/ - -static mcPretty_pretty outKm2 (mcPretty_pretty p, const char *a_, unsigned int _a_high) -{ - unsigned int i; - DynamicStrings_String s; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "RECORD", 6)) - { - p = mcPretty_pushPretty (p); - i = mcPretty_getcurpos (p); - mcPretty_setindent (p, i); - outText (p, (const char *) a, _a_high); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, i+indentation); - } - else if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "END", 3)) - { - /* avoid dangling else. */ - p = mcPretty_popPretty (p); - outText (p, (const char *) a, _a_high); - p = mcPretty_popPretty (p); - } - return p; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - outKc - -*/ - -static mcPretty_pretty outKc (mcPretty_pretty p, const char *a_, unsigned int _a_high) -{ - int i; - unsigned int c; - DynamicStrings_String s; - DynamicStrings_String t; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - s = DynamicStrings_InitString ((const char *) a, _a_high); - i = DynamicStrings_Index (s, '\\', 0); - if (i == -1) - { - t = NULL; - } - else - { - t = DynamicStrings_Slice (s, i, 0); - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i); - } - if ((DynamicStrings_char (s, 0)) == '{') - { - p = mcPretty_pushPretty (p); - c = mcPretty_getcurpos (p); - mcPretty_setindent (p, c); - outTextS (p, s); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, c+indentationC); - } - else if ((DynamicStrings_char (s, 0)) == '}') - { - /* avoid dangling else. */ - p = mcPretty_popPretty (p); - outTextS (p, s); - p = mcPretty_popPretty (p); - } - outTextS (p, t); - t = DynamicStrings_KillString (t); - s = DynamicStrings_KillString (s); - return p; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - outTextS - -*/ - -static void outTextS (mcPretty_pretty p, DynamicStrings_String s) -{ - if (s != NULL) - { - mcPretty_prints (p, s); - } -} - - -/* - outCard - -*/ - -static void outCard (mcPretty_pretty p, unsigned int c) -{ - DynamicStrings_String s; - - s = StringConvert_CardinalToString (c, 0, ' ', 10, FALSE); - outTextS (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - outTextN - -*/ - -static void outTextN (mcPretty_pretty p, nameKey_Name n) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); - mcPretty_prints (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - doTypeAliasC - -*/ - -static void doTypeAliasC (mcPretty_pretty p, decl_node n, decl_node *m) -{ - mcPretty_print (p, (const char *) "typedef", 7); - mcPretty_setNeedSpace (p); - if ((decl_isTypeHidden (n)) && ((decl_isDef (decl_getMainModule ())) || ((decl_getScope (n)) != (decl_getMainModule ())))) - { - outText (p, (const char *) "void *", 6); - } - else - { - doTypeC (p, decl_getType (n), m); - } - if ((*m) != NULL) - { - doFQNameC (p, (*m)); - } - mcPretty_print (p, (const char *) ";\\n\\n", 5); -} - - -/* - doEnumerationC - -*/ - -static void doEnumerationC (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node s; - DynamicStrings_String t; - - outText (p, (const char *) "enum {", 6); - i = Indexing_LowIndice (n->enumerationF.listOfSons); - h = Indexing_HighIndice (n->enumerationF.listOfSons); - while (i <= h) - { - s = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); - doFQDNameC (p, s, FALSE); - if (i < h) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - i += 1; - } - outText (p, (const char *) "}", 1); -} - - -/* - doNamesC - -*/ - -static void doNamesC (mcPretty_pretty p, nameKey_Name n) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); - outTextS (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - doNameC - -*/ - -static void doNameC (mcPretty_pretty p, decl_node n) -{ - if ((n != NULL) && ((decl_getSymName (n)) != nameKey_NulName)) - { - doNamesC (p, decl_getSymName (n)); - } -} - - -/* - initCname - -*/ - -static void initCname (decl_cnameT *c) -{ - (*c).init = FALSE; -} - - -/* - doCname - -*/ - -static nameKey_Name doCname (nameKey_Name n, decl_cnameT *c, unsigned int scopes) -{ - DynamicStrings_String s; - - if ((*c).init) - { - return (*c).name; - } - else - { - (*c).init = TRUE; - s = keyc_cname (n, scopes); - if (s == NULL) - { - (*c).name = n; - } - else - { - (*c).name = nameKey_makekey (DynamicStrings_string (s)); - s = DynamicStrings_KillString (s); - } - return (*c).name; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getDName - -*/ - -static nameKey_Name getDName (decl_node n, unsigned int scopes) -{ - nameKey_Name m; - - m = decl_getSymName (n); - switch (n->kind) - { - case decl_procedure: - return doCname (m, &n->procedureF.cname, scopes); - break; - - case decl_var: - return doCname (m, &n->varF.cname, scopes); - break; - - case decl_recordfield: - return doCname (m, &n->recordfieldF.cname, scopes); - break; - - case decl_enumerationfield: - return doCname (m, &n->enumerationfieldF.cname, scopes); - break; - - - default: - break; - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doDNameC - -*/ - -static void doDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes) -{ - if ((n != NULL) && ((decl_getSymName (n)) != nameKey_NulName)) - { - doNamesC (p, getDName (n, scopes)); - } -} - - -/* - doFQDNameC - -*/ - -static void doFQDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes) -{ - DynamicStrings_String s; - - s = getFQDstring (n, scopes); - outTextS (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - doFQNameC - -*/ - -static void doFQNameC (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - s = getFQstring (n); - outTextS (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - doNameM2 - -*/ - -static void doNameM2 (mcPretty_pretty p, decl_node n) -{ - doNameC (p, n); -} - - -/* - doUsed - -*/ - -static void doUsed (mcPretty_pretty p, unsigned int used) -{ - if (! used) - { - mcPretty_setNeedSpace (p); - outText (p, (const char *) "__attribute__((unused))", 23); - } -} - - -/* - doHighC - -*/ - -static void doHighC (mcPretty_pretty p, decl_node a, nameKey_Name n, unsigned int isused) -{ - if ((decl_isArray (a)) && (decl_isUnbounded (a))) - { - /* need to display high. */ - mcPretty_print (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - doTypeNameC (p, cardinalN); - mcPretty_setNeedSpace (p); - mcPretty_print (p, (const char *) "_", 1); - outTextN (p, n); - mcPretty_print (p, (const char *) "_high", 5); - doUsed (p, isused); - } -} - - -/* - doParamConstCast - -*/ - -static void doParamConstCast (mcPretty_pretty p, decl_node n) -{ - decl_node ptype; - - ptype = decl_getType (n); - if (((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) && (lang == decl_ansiCP)) - { - outText (p, (const char *) "const", 5); - mcPretty_setNeedSpace (p); - } -} - - -/* - getParameterVariable - returns the variable which shadows the parameter - named, m, in parameter block, n. -*/ - -static decl_node getParameterVariable (decl_node n, nameKey_Name m) -{ - decl_node p; - - mcDebug_assert ((decl_isParam (n)) || (decl_isVarParam (n))); - if (decl_isParam (n)) - { - p = n->paramF.scope; - } - else - { - p = n->varparamF.scope; - } - mcDebug_assert (decl_isProcedure (p)); - return decl_lookupInScope (p, m); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doParamTypeEmit - emit parameter type for C/C++. It checks to see if the - parameter type is a procedure type and if it were declared - in a definition module for "C" and if so it uses the "C" - definition for a procedure type, rather than the mc - C++ version. -*/ - -static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype) -{ - mcDebug_assert ((decl_isParam (paramnode)) || (decl_isVarParam (paramnode))); - if ((isForC (paramnode)) && (decl_isProcType (decl_skipType (paramtype)))) - { - doFQNameC (p, paramtype); - outText (p, (const char *) "_C", 2); - } - else - { - doTypeNameC (p, paramtype); - } -} - - -/* - doParamC - emit parameter for C/C++. -*/ - -static void doParamC (mcPretty_pretty p, decl_node n) -{ - decl_node v; - decl_node ptype; - nameKey_Name i; - unsigned int c; - unsigned int t; - wlists_wlist l; - - mcDebug_assert (decl_isParam (n)); - ptype = decl_getType (n); - if (n->paramF.namelist == NULL) - { - /* avoid dangling else. */ - doParamConstCast (p, n); - doTypeNameC (p, ptype); - doUsed (p, n->paramF.isUsed); - if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "unsigned int", 12); - } - } - else - { - mcDebug_assert (isIdentList (n->paramF.namelist)); - l = n->paramF.namelist->identlistF.names; - if (l == NULL) - { - /* avoid dangling else. */ - doParamConstCast (p, n); - doParamTypeEmit (p, n, ptype); - if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) - { - doUsed (p, n->paramF.isUsed); - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "unsigned int", 12); - } - } - else - { - t = wlists_noOfItemsInList (l); - c = 1; - while (c <= t) - { - doParamConstCast (p, n); - doParamTypeEmit (p, n, ptype); - i = static_cast (wlists_getItemFromList (l, c)); - if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) - { - mcPretty_noSpace (p); - } - else - { - mcPretty_setNeedSpace (p); - } - v = getParameterVariable (n, i); - if (v == NULL) - { - doNamesC (p, keyc_cnamen (i, TRUE)); - } - else - { - doFQDNameC (p, v, TRUE); - } - if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) - { - outText (p, (const char *) "_", 1); - } - doUsed (p, n->paramF.isUsed); - doHighC (p, ptype, i, n->paramF.isUsed); - if (c < t) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - c += 1; - } - } - } -} - - -/* - doVarParamC - emit a VAR parameter for C/C++. -*/ - -static void doVarParamC (mcPretty_pretty p, decl_node n) -{ - decl_node v; - decl_node ptype; - nameKey_Name i; - unsigned int c; - unsigned int t; - wlists_wlist l; - - mcDebug_assert (decl_isVarParam (n)); - ptype = decl_getType (n); - if (n->varparamF.namelist == NULL) - { - /* avoid dangling else. */ - doTypeNameC (p, ptype); - /* doTypeC (p, ptype, n) ; */ - if (! (decl_isArray (ptype))) - { - mcPretty_setNeedSpace (p); - outText (p, (const char *) "*", 1); - } - doUsed (p, n->varparamF.isUsed); - if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "unsigned int", 12); - } - } - else - { - mcDebug_assert (isIdentList (n->varparamF.namelist)); - l = n->varparamF.namelist->identlistF.names; - if (l == NULL) - { - doParamTypeEmit (p, n, ptype); - doUsed (p, n->varparamF.isUsed); - } - else - { - t = wlists_noOfItemsInList (l); - c = 1; - while (c <= t) - { - doParamTypeEmit (p, n, ptype); - if (! (decl_isArray (ptype))) - { - mcPretty_setNeedSpace (p); - outText (p, (const char *) "*", 1); - } - i = static_cast (wlists_getItemFromList (l, c)); - v = getParameterVariable (n, i); - if (v == NULL) - { - doNamesC (p, keyc_cnamen (i, TRUE)); - } - else - { - doFQDNameC (p, v, TRUE); - } - doUsed (p, n->varparamF.isUsed); - doHighC (p, ptype, i, n->varparamF.isUsed); - if (c < t) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - c += 1; - } - } - } -} - - -/* - doOptargC - -*/ - -static void doOptargC (mcPretty_pretty p, decl_node n) -{ - decl_node ptype; - nameKey_Name i; - unsigned int t; - wlists_wlist l; - - mcDebug_assert (decl_isOptarg (n)); - ptype = decl_getType (n); - mcDebug_assert (n->optargF.namelist != NULL); - mcDebug_assert (isIdentList (n->paramF.namelist)); - l = n->paramF.namelist->identlistF.names; - mcDebug_assert (l != NULL); - t = wlists_noOfItemsInList (l); - mcDebug_assert (t == 1); - doTypeNameC (p, ptype); - i = static_cast (wlists_getItemFromList (l, 1)); - mcPretty_setNeedSpace (p); - doNamesC (p, i); -} - - -/* - doParameterC - -*/ - -static void doParameterC (mcPretty_pretty p, decl_node n) -{ - if (decl_isParam (n)) - { - doParamC (p, n); - } - else if (decl_isVarParam (n)) - { - /* avoid dangling else. */ - doVarParamC (p, n); - } - else if (decl_isVarargs (n)) - { - /* avoid dangling else. */ - mcPretty_print (p, (const char *) "...", 3); - } - else if (decl_isOptarg (n)) - { - /* avoid dangling else. */ - doOptargC (p, n); - } -} - - -/* - doProcTypeC - -*/ - -static void doProcTypeC (mcPretty_pretty p, decl_node t, decl_node n) -{ - mcDebug_assert (decl_isType (t)); - outputPartial (t); - doCompletePartialProcType (p, t, n); -} - - -/* - doTypesC - -*/ - -static void doTypesC (decl_node n) -{ - decl_node m; - - if (decl_isType (n)) - { - m = decl_getType (n); - if (decl_isProcType (m)) - { - doProcTypeC (doP, n, m); - } - else if ((decl_isType (m)) || (decl_isPointer (m))) - { - /* avoid dangling else. */ - outText (doP, (const char *) "typedef", 7); - mcPretty_setNeedSpace (doP); - doTypeC (doP, m, &m); - if (decl_isType (m)) - { - mcPretty_setNeedSpace (doP); - } - doTypeNameC (doP, n); - outText (doP, (const char *) ";\\n\\n", 5); - } - else if (decl_isEnumeration (m)) - { - /* avoid dangling else. */ - outText (doP, (const char *) "typedef", 7); - mcPretty_setNeedSpace (doP); - doTypeC (doP, m, &m); - mcPretty_setNeedSpace (doP); - doTypeNameC (doP, n); - outText (doP, (const char *) ";\\n\\n", 5); - } - else - { - /* avoid dangling else. */ - outText (doP, (const char *) "typedef", 7); - mcPretty_setNeedSpace (doP); - doTypeC (doP, m, &m); - if (decl_isType (m)) - { - mcPretty_setNeedSpace (doP); - } - doTypeNameC (doP, n); - outText (doP, (const char *) ";\\n\\n", 5); - } - } -} - - -/* - doCompletePartialC - -*/ - -static void doCompletePartialC (decl_node n) -{ - decl_node m; - - if (decl_isType (n)) - { - m = decl_getType (n); - if (decl_isRecord (m)) - { - doCompletePartialRecord (doP, n, m); - } - else if (decl_isArray (m)) - { - /* avoid dangling else. */ - doCompletePartialArray (doP, n, m); - } - else if (decl_isProcType (m)) - { - /* avoid dangling else. */ - doCompletePartialProcType (doP, n, m); - } - } -} - - -/* - doCompletePartialRecord - -*/ - -static void doCompletePartialRecord (mcPretty_pretty p, decl_node t, decl_node r) -{ - unsigned int i; - unsigned int h; - decl_node f; - - mcDebug_assert (decl_isRecord (r)); - mcDebug_assert (decl_isType (t)); - outText (p, (const char *) "struct", 6); - mcPretty_setNeedSpace (p); - doFQNameC (p, t); - outText (p, (const char *) "_r", 2); - mcPretty_setNeedSpace (p); - p = outKc (p, (const char *) "{\\n", 3); - i = Indexing_LowIndice (r->recordF.listOfSons); - h = Indexing_HighIndice (r->recordF.listOfSons); - while (i <= h) - { - f = static_cast (Indexing_GetIndice (r->recordF.listOfSons, i)); - if (decl_isRecordField (f)) - { - /* avoid dangling else. */ - if (! f->recordfieldF.tag) - { - mcPretty_setNeedSpace (p); - doRecordFieldC (p, f); - outText (p, (const char *) ";\\n", 3); - } - } - else if (decl_isVarient (f)) - { - /* avoid dangling else. */ - doVarientC (p, f); - outText (p, (const char *) ";\\n", 3); - } - else if (decl_isVarientField (f)) - { - /* avoid dangling else. */ - doVarientFieldC (p, f); - } - i += 1; - } - p = outKc (p, (const char *) "};\\n\\n", 6); -} - - -/* - doCompletePartialArray - -*/ - -static void doCompletePartialArray (mcPretty_pretty p, decl_node t, decl_node r) -{ - decl_node type; - decl_node s; - - mcDebug_assert (decl_isArray (r)); - type = r->arrayF.type; - s = NULL; - outText (p, (const char *) "struct", 6); - mcPretty_setNeedSpace (p); - doFQNameC (p, t); - outText (p, (const char *) "_a {", 4); - mcPretty_setNeedSpace (p); - doTypeC (p, type, &s); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "array[", 6); - doSubrC (p, r->arrayF.subr); - outText (p, (const char *) "];", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "};\\n", 4); -} - - -/* - lookupConst - -*/ - -static decl_node lookupConst (decl_node type, nameKey_Name n) -{ - return decl_makeLiteralInt (n); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doMin - -*/ - -static decl_node doMin (decl_node n) -{ - if (n == booleanN) - { - return falseN; - } - else if (n == integerN) - { - /* avoid dangling else. */ - keyc_useIntMin (); - return lookupConst (integerN, nameKey_makeKey ((const char *) "INT_MIN", 7)); - } - else if (n == cardinalN) - { - /* avoid dangling else. */ - keyc_useUIntMin (); - return lookupConst (cardinalN, nameKey_makeKey ((const char *) "UINT_MIN", 8)); - } - else if (n == longintN) - { - /* avoid dangling else. */ - keyc_useLongMin (); - return lookupConst (longintN, nameKey_makeKey ((const char *) "LONG_MIN", 8)); - } - else if (n == longcardN) - { - /* avoid dangling else. */ - keyc_useULongMin (); - return lookupConst (longcardN, nameKey_makeKey ((const char *) "LONG_MIN", 8)); - } - else if (n == charN) - { - /* avoid dangling else. */ - keyc_useCharMin (); - return lookupConst (charN, nameKey_makeKey ((const char *) "CHAR_MIN", 8)); - } - else if (n == bitsetN) - { - /* avoid dangling else. */ - mcDebug_assert (decl_isSubrange (bitnumN)); - return bitnumN->subrangeF.low; - } - else if (n == locN) - { - /* avoid dangling else. */ - keyc_useUCharMin (); - return lookupConst (locN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9)); - } - else if (n == byteN) - { - /* avoid dangling else. */ - keyc_useUCharMin (); - return lookupConst (byteN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9)); - } - else if (n == wordN) - { - /* avoid dangling else. */ - keyc_useUIntMin (); - return lookupConst (wordN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9)); - } - else if (n == addressN) - { - /* avoid dangling else. */ - return lookupConst (addressN, nameKey_makeKey ((const char *) "((void *) 0)", 12)); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); /* finish the cacading elsif statement. */ - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - doMax - -*/ - -static decl_node doMax (decl_node n) -{ - if (n == booleanN) - { - return trueN; - } - else if (n == integerN) - { - /* avoid dangling else. */ - keyc_useIntMax (); - return lookupConst (integerN, nameKey_makeKey ((const char *) "INT_MAX", 7)); - } - else if (n == cardinalN) - { - /* avoid dangling else. */ - keyc_useUIntMax (); - return lookupConst (cardinalN, nameKey_makeKey ((const char *) "UINT_MAX", 8)); - } - else if (n == longintN) - { - /* avoid dangling else. */ - keyc_useLongMax (); - return lookupConst (longintN, nameKey_makeKey ((const char *) "LONG_MAX", 8)); - } - else if (n == longcardN) - { - /* avoid dangling else. */ - keyc_useULongMax (); - return lookupConst (longcardN, nameKey_makeKey ((const char *) "ULONG_MAX", 9)); - } - else if (n == charN) - { - /* avoid dangling else. */ - keyc_useCharMax (); - return lookupConst (charN, nameKey_makeKey ((const char *) "CHAR_MAX", 8)); - } - else if (n == bitsetN) - { - /* avoid dangling else. */ - mcDebug_assert (decl_isSubrange (bitnumN)); - return bitnumN->subrangeF.high; - } - else if (n == locN) - { - /* avoid dangling else. */ - keyc_useUCharMax (); - return lookupConst (locN, nameKey_makeKey ((const char *) "UCHAR_MAX", 9)); - } - else if (n == byteN) - { - /* avoid dangling else. */ - keyc_useUCharMax (); - return lookupConst (byteN, nameKey_makeKey ((const char *) "UCHAR_MAX", 9)); - } - else if (n == wordN) - { - /* avoid dangling else. */ - keyc_useUIntMax (); - return lookupConst (wordN, nameKey_makeKey ((const char *) "UINT_MAX", 8)); - } - else if (n == addressN) - { - /* avoid dangling else. */ - mcMetaError_metaError1 ((const char *) "trying to obtain MAX ({%1ad}) is illegal", 40, (const unsigned char *) &n, (sizeof (n)-1)); - return NULL; - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); /* finish the cacading elsif statement. */ - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - getMax - -*/ - -static decl_node getMax (decl_node n) -{ - n = decl_skipType (n); - if (decl_isSubrange (n)) - { - return n->subrangeF.high; - } - else if (decl_isEnumeration (n)) - { - /* avoid dangling else. */ - return n->enumerationF.high; - } - else - { - /* avoid dangling else. */ - mcDebug_assert (isOrdinal (n)); - return doMax (n); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getMin - -*/ - -static decl_node getMin (decl_node n) -{ - n = decl_skipType (n); - if (decl_isSubrange (n)) - { - return n->subrangeF.low; - } - else if (decl_isEnumeration (n)) - { - /* avoid dangling else. */ - return n->enumerationF.low; - } - else - { - /* avoid dangling else. */ - mcDebug_assert (isOrdinal (n)); - return doMin (n); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doSubtractC - -*/ - -static void doSubtractC (mcPretty_pretty p, decl_node s) -{ - if (! (isZero (s))) - { - outText (p, (const char *) "-", 1); - doExprC (p, s); - } -} - - -/* - doSubrC - -*/ - -static void doSubrC (mcPretty_pretty p, decl_node s) -{ - decl_node low; - decl_node high; - - s = decl_skipType (s); - if (isOrdinal (s)) - { - low = getMin (s); - high = getMax (s); - doExprC (p, high); - doSubtractC (p, low); - outText (p, (const char *) "+1", 2); - } - else if (decl_isEnumeration (s)) - { - /* avoid dangling else. */ - low = getMin (s); - high = getMax (s); - doExprC (p, high); - doSubtractC (p, low); - outText (p, (const char *) "+1", 2); - } - else - { - /* avoid dangling else. */ - mcDebug_assert (decl_isSubrange (s)); - if ((s->subrangeF.high == NULL) || (s->subrangeF.low == NULL)) - { - doSubrC (p, decl_getType (s)); - } - else - { - doExprC (p, s->subrangeF.high); - doSubtractC (p, s->subrangeF.low); - outText (p, (const char *) "+1", 2); - } - } -} - - -/* - doCompletePartialProcType - -*/ - -static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node v; - decl_node u; - - mcDebug_assert (decl_isProcType (n)); - u = NULL; - outText (p, (const char *) "typedef", 7); - mcPretty_setNeedSpace (p); - doTypeC (p, n->proctypeF.returnType, &u); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(*", 2); - doFQNameC (p, t); - outText (p, (const char *) "_t) (", 5); - i = Indexing_LowIndice (n->proctypeF.parameters); - h = Indexing_HighIndice (n->proctypeF.parameters); - while (i <= h) - { - v = static_cast (Indexing_GetIndice (n->proctypeF.parameters, i)); - doParameterC (p, v); - mcPretty_noSpace (p); - if (i < h) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - i += 1; - } - if (h == 0) - { - outText (p, (const char *) "void", 4); - } - outText (p, (const char *) ");\\n", 4); - if (isDefForCNode (n)) - { - /* emit a C named type which differs from the m2 proctype. */ - outText (p, (const char *) "typedef", 7); - mcPretty_setNeedSpace (p); - doFQNameC (p, t); - outText (p, (const char *) "_t", 2); - mcPretty_setNeedSpace (p); - doFQNameC (p, t); - outText (p, (const char *) "_C;\\n\\n", 7); - } - outText (p, (const char *) "struct", 6); - mcPretty_setNeedSpace (p); - doFQNameC (p, t); - outText (p, (const char *) "_p {", 4); - mcPretty_setNeedSpace (p); - doFQNameC (p, t); - outText (p, (const char *) "_t proc; };\\n\\n", 15); -} - - -/* - isBase - -*/ - -static unsigned int isBase (decl_node n) -{ - switch (n->kind) - { - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_boolean: - case decl_proc: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doBaseC - -*/ - -static void doBaseC (mcPretty_pretty p, decl_node n) -{ - switch (n->kind) - { - case decl_char: - outText (p, (const char *) "char", 4); - break; - - case decl_cardinal: - outText (p, (const char *) "unsigned int", 12); - break; - - case decl_longcard: - outText (p, (const char *) "long unsigned int", 17); - break; - - case decl_shortcard: - outText (p, (const char *) "short unsigned int", 18); - break; - - case decl_integer: - outText (p, (const char *) "int", 3); - break; - - case decl_longint: - outText (p, (const char *) "long int", 8); - break; - - case decl_shortint: - outText (p, (const char *) "short int", 9); - break; - - case decl_complex: - outText (p, (const char *) "double complex", 14); - break; - - case decl_longcomplex: - outText (p, (const char *) "long double complex", 19); - break; - - case decl_shortcomplex: - outText (p, (const char *) "float complex", 13); - break; - - case decl_real: - outText (p, (const char *) "double", 6); - break; - - case decl_longreal: - outText (p, (const char *) "long double", 11); - break; - - case decl_shortreal: - outText (p, (const char *) "float", 5); - break; - - case decl_bitset: - outText (p, (const char *) "unsigned int", 12); - break; - - case decl_boolean: - outText (p, (const char *) "unsigned int", 12); - break; - - case decl_proc: - outText (p, (const char *) "PROC", 4); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - mcPretty_setNeedSpace (p); -} - - -/* - isSystem - -*/ - -static unsigned int isSystem (decl_node n) -{ - switch (n->kind) - { - case decl_address: - return TRUE; - break; - - case decl_loc: - return TRUE; - break; - - case decl_byte: - return TRUE; - break; - - case decl_word: - return TRUE; - break; - - case decl_csizet: - return TRUE; - break; - - case decl_cssizet: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doSystemC - -*/ - -static void doSystemC (mcPretty_pretty p, decl_node n) -{ - switch (n->kind) - { - case decl_address: - outText (p, (const char *) "void *", 6); - break; - - case decl_loc: - outText (p, (const char *) "unsigned char", 13); - mcPretty_setNeedSpace (p); - break; - - case decl_byte: - outText (p, (const char *) "unsigned char", 13); - mcPretty_setNeedSpace (p); - break; - - case decl_word: - outText (p, (const char *) "unsigned int", 12); - mcPretty_setNeedSpace (p); - break; - - case decl_csizet: - outText (p, (const char *) "size_t", 6); - mcPretty_setNeedSpace (p); - keyc_useSize_t (); - break; - - case decl_cssizet: - outText (p, (const char *) "ssize_t", 7); - mcPretty_setNeedSpace (p); - keyc_useSSize_t (); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - doArrayC - -*/ - -static void doArrayC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - decl_node s; - decl_node u; - - mcDebug_assert (decl_isArray (n)); - t = n->arrayF.type; - s = n->arrayF.subr; - u = NULL; - if (s == NULL) - { - doTypeC (p, t, &u); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "*", 1); - } - else - { - outText (p, (const char *) "struct", 6); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "{", 1); - mcPretty_setNeedSpace (p); - doTypeC (p, t, &u); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "array[", 6); - if (isZero (getMin (s))) - { - doExprC (p, getMax (s)); - } - else - { - doExprC (p, getMax (s)); - doSubtractC (p, getMin (s)); - } - outText (p, (const char *) "];", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "}", 1); - mcPretty_setNeedSpace (p); - } -} - - -/* - doPointerC - -*/ - -static void doPointerC (mcPretty_pretty p, decl_node n, decl_node *m) -{ - decl_node t; - decl_node s; - - t = n->pointerF.type; - s = NULL; - doTypeC (p, t, &s); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "*", 1); -} - - -/* - doRecordFieldC - -*/ - -static void doRecordFieldC (mcPretty_pretty p, decl_node f) -{ - decl_node m; - - m = NULL; - mcPretty_setNeedSpace (p); - doTypeC (p, f->recordfieldF.type, &m); - doDNameC (p, f, FALSE); -} - - -/* - doVarientFieldC - -*/ - -static void doVarientFieldC (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - mcDebug_assert (decl_isVarientField (n)); - if (! n->varientfieldF.simple) - { - outText (p, (const char *) "struct", 6); - mcPretty_setNeedSpace (p); - p = outKc (p, (const char *) "{\\n", 3); - } - i = Indexing_LowIndice (n->varientfieldF.listOfSons); - t = Indexing_HighIndice (n->varientfieldF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientfieldF.listOfSons, i)); - if (decl_isRecordField (q)) - { - /* avoid dangling else. */ - if (! q->recordfieldF.tag) - { - doRecordFieldC (p, q); - outText (p, (const char *) ";\\n", 3); - } - } - else if (decl_isVarient (q)) - { - /* avoid dangling else. */ - doVarientC (p, q); - outText (p, (const char *) ";\\n", 3); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - i += 1; - } - if (! n->varientfieldF.simple) - { - p = outKc (p, (const char *) "};\\n", 4); - } -} - - -/* - doVarientC - -*/ - -static void doVarientC (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - mcDebug_assert (decl_isVarient (n)); - if (n->varientF.tag != NULL) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (decl_isRecordField (n->varientF.tag)) - { - doRecordFieldC (p, n->varientF.tag); - outText (p, (const char *) "; /* case tag */\\n", 19); - } - else if (decl_isVarientField (n->varientF.tag)) - { - /* avoid dangling else. */ - /* doVarientFieldC (p, n^.varientF.tag) */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - outText (p, (const char *) "union", 5); - mcPretty_setNeedSpace (p); - p = outKc (p, (const char *) "{\\n", 3); - i = Indexing_LowIndice (n->varientF.listOfSons); - t = Indexing_HighIndice (n->varientF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); - if (decl_isRecordField (q)) - { - /* avoid dangling else. */ - if (! q->recordfieldF.tag) - { - doRecordFieldC (p, q); - outText (p, (const char *) ";\\n", 3); - } - } - else if (decl_isVarientField (q)) - { - /* avoid dangling else. */ - doVarientFieldC (p, q); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - i += 1; - } - p = outKc (p, (const char *) "}", 1); -} - - -/* - doRecordC - -*/ - -static void doRecordC (mcPretty_pretty p, decl_node n, decl_node *m) -{ - unsigned int i; - unsigned int h; - decl_node f; - - mcDebug_assert (decl_isRecord (n)); - outText (p, (const char *) "struct", 6); - mcPretty_setNeedSpace (p); - p = outKc (p, (const char *) "{", 1); - i = Indexing_LowIndice (n->recordF.listOfSons); - h = Indexing_HighIndice (n->recordF.listOfSons); - mcPretty_setindent (p, (mcPretty_getcurpos (p))+indentation); - outText (p, (const char *) "\\n", 2); - while (i <= h) - { - f = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); - if (decl_isRecordField (f)) - { - /* avoid dangling else. */ - if (! f->recordfieldF.tag) - { - doRecordFieldC (p, f); - outText (p, (const char *) ";\\n", 3); - } - } - else if (decl_isVarient (f)) - { - /* avoid dangling else. */ - doVarientC (p, f); - outText (p, (const char *) ";\\n", 3); - } - else if (decl_isVarientField (f)) - { - /* avoid dangling else. */ - doVarientFieldC (p, f); - } - i += 1; - } - p = outKc (p, (const char *) "}", 1); - mcPretty_setNeedSpace (p); -} - - -/* - isBitset - -*/ - -static unsigned int isBitset (decl_node n) -{ - return n == bitsetN; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isNegative - returns TRUE if expression, n, is negative. -*/ - -static unsigned int isNegative (decl_node n) -{ - /* --fixme-- needs to be completed. */ - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doSubrangeC - -*/ - -static void doSubrangeC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (decl_isSubrange (n)); - if (isNegative (n->subrangeF.low)) - { - outText (p, (const char *) "int", 3); - mcPretty_setNeedSpace (p); - } - else - { - outText (p, (const char *) "unsigned int", 12); - mcPretty_setNeedSpace (p); - } -} - - -/* - doSetC - generates a C type which holds the set. - Currently we only support sets of size WORD. -*/ - -static void doSetC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (decl_isSet (n)); - outText (p, (const char *) "unsigned int", 12); - mcPretty_setNeedSpace (p); -} - - -/* - doTypeC - -*/ - -static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m) -{ - if (n == NULL) - { - outText (p, (const char *) "void", 4); - } - else if (isBase (n)) - { - /* avoid dangling else. */ - doBaseC (p, n); - } - else if (isSystem (n)) - { - /* avoid dangling else. */ - doSystemC (p, n); - } - else if (decl_isEnumeration (n)) - { - /* avoid dangling else. */ - doEnumerationC (p, n); - } - else if (decl_isType (n)) - { - /* avoid dangling else. */ - doFQNameC (p, n); - /* - ELSIF isProcType (n) OR isArray (n) OR isRecord (n) - THEN - HALT n should have been simplified. - */ - mcPretty_setNeedSpace (p); - } - else if (decl_isProcType (n)) - { - /* avoid dangling else. */ - doProcTypeC (p, n, (*m)); - } - else if (decl_isArray (n)) - { - /* avoid dangling else. */ - doArrayC (p, n); - } - else if (decl_isRecord (n)) - { - /* avoid dangling else. */ - doRecordC (p, n, m); - } - else if (decl_isPointer (n)) - { - /* avoid dangling else. */ - doPointerC (p, n, m); - } - else if (decl_isSubrange (n)) - { - /* avoid dangling else. */ - doSubrangeC (p, n); - } - else if (decl_isSet (n)) - { - /* avoid dangling else. */ - doSetC (p, n); - } - else - { - /* avoid dangling else. */ - /* --fixme-- */ - mcPretty_print (p, (const char *) "to do ... typedef etc etc ", 27); - doFQNameC (p, n); - mcPretty_print (p, (const char *) ";\\n", 3); - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - doArrayNameC - it displays the array declaration (it might be an unbounded). -*/ - -static void doArrayNameC (mcPretty_pretty p, decl_node n) -{ - doTypeNameC (p, decl_getType (n)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "*", 1); -} - - -/* - doRecordNameC - emit the C/C++ record name "_r". -*/ - -static void doRecordNameC (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - s = getFQstring (n); - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_r", 2))); - outTextS (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - doPointerNameC - emit the C/C++ pointer type *. -*/ - -static void doPointerNameC (mcPretty_pretty p, decl_node n) -{ - doTypeNameC (p, decl_getType (n)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "*", 1); -} - - -/* - doTypeNameC - -*/ - -static void doTypeNameC (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String t; - - if (n == NULL) - { - outText (p, (const char *) "void", 4); - mcPretty_setNeedSpace (p); - } - else if (isBase (n)) - { - /* avoid dangling else. */ - doBaseC (p, n); - } - else if (isSystem (n)) - { - /* avoid dangling else. */ - doSystemC (p, n); - } - else if (decl_isEnumeration (n)) - { - /* avoid dangling else. */ - mcPretty_print (p, (const char *) "is enumeration type name required\\n", 35); - } - else if (decl_isType (n)) - { - /* avoid dangling else. */ - doFQNameC (p, n); - } - else if (decl_isProcType (n)) - { - /* avoid dangling else. */ - doFQNameC (p, n); - outText (p, (const char *) "_t", 2); - } - else if (decl_isArray (n)) - { - /* avoid dangling else. */ - doArrayNameC (p, n); - } - else if (decl_isRecord (n)) - { - /* avoid dangling else. */ - doRecordNameC (p, n); - } - else if (decl_isPointer (n)) - { - /* avoid dangling else. */ - doPointerNameC (p, n); - } - else if (decl_isSubrange (n)) - { - /* avoid dangling else. */ - doSubrangeC (p, n); - } - else - { - /* avoid dangling else. */ - mcPretty_print (p, (const char *) "is type unknown required\\n", 26); - stop (); - } -} - - -/* - isExternal - returns TRUE if symbol, n, was declared in another module. -*/ - -static unsigned int isExternal (decl_node n) -{ - decl_node s; - - s = decl_getScope (n); - return ((s != NULL) && (decl_isDef (s))) && (((decl_isImp (decl_getMainModule ())) && (s != (decl_lookupDef (decl_getSymName (decl_getMainModule ()))))) || (decl_isModule (decl_getMainModule ()))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doVarC - -*/ - -static void doVarC (decl_node n) -{ - decl_node s; - - if (decl_isDef (decl_getMainModule ())) - { - mcPretty_print (doP, (const char *) "EXTERN", 6); - mcPretty_setNeedSpace (doP); - } - else if ((! (decl_isExported (n))) && (! (isLocal (n)))) - { - /* avoid dangling else. */ - mcPretty_print (doP, (const char *) "static", 6); - mcPretty_setNeedSpace (doP); - } - else if (mcOptions_getExtendedOpaque ()) - { - /* avoid dangling else. */ - if (isExternal (n)) - { - /* different module declared this variable, therefore it is extern. */ - mcPretty_print (doP, (const char *) "extern", 6); - mcPretty_setNeedSpace (doP); - } - } - s = NULL; - doTypeC (doP, decl_getType (n), &s); - mcPretty_setNeedSpace (doP); - doFQDNameC (doP, n, FALSE); - mcPretty_print (doP, (const char *) ";\\n", 3); -} - - -/* - doExternCP - -*/ - -static void doExternCP (mcPretty_pretty p) -{ - if (lang == decl_ansiCP) - { - outText (p, (const char *) "extern \"C\"", 10); - mcPretty_setNeedSpace (p); - } -} - - -/* - doProcedureCommentText - -*/ - -static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s) -{ - /* remove - from the start of the comment. */ - while (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, 0)) == ASCII_lf)) - { - s = DynamicStrings_Slice (s, 1, 0); - } - outTextS (p, s); -} - - -/* - doProcedureComment - -*/ - -static void doProcedureComment (mcPretty_pretty p, DynamicStrings_String s) -{ - if (s != NULL) - { - outText (p, (const char *) "\\n/*\\n", 6); - doProcedureCommentText (p, s); - outText (p, (const char *) "*/\\n\\n", 6); - } -} - - -/* - doProcedureHeadingC - -*/ - -static void doProcedureHeadingC (decl_node n, unsigned int prototype) -{ - unsigned int i; - unsigned int h; - decl_node p; - decl_node q; - - mcDebug_assert (decl_isProcedure (n)); - mcPretty_noSpace (doP); - if (decl_isDef (decl_getMainModule ())) - { - doProcedureComment (doP, mcComment_getContent (n->procedureF.defComment)); - outText (doP, (const char *) "EXTERN", 6); - mcPretty_setNeedSpace (doP); - } - else if (decl_isExported (n)) - { - /* avoid dangling else. */ - doProcedureComment (doP, mcComment_getContent (n->procedureF.modComment)); - doExternCP (doP); - } - else - { - /* avoid dangling else. */ - doProcedureComment (doP, mcComment_getContent (n->procedureF.modComment)); - outText (doP, (const char *) "static", 6); - mcPretty_setNeedSpace (doP); - } - q = NULL; - doTypeC (doP, n->procedureF.returnType, &q); - mcPretty_setNeedSpace (doP); - doFQDNameC (doP, n, FALSE); - mcPretty_setNeedSpace (doP); - outText (doP, (const char *) "(", 1); - i = Indexing_LowIndice (n->procedureF.parameters); - h = Indexing_HighIndice (n->procedureF.parameters); - while (i <= h) - { - p = static_cast (Indexing_GetIndice (n->procedureF.parameters, i)); - doParameterC (doP, p); - mcPretty_noSpace (doP); - if (i < h) - { - mcPretty_print (doP, (const char *) ",", 1); - mcPretty_setNeedSpace (doP); - } - i += 1; - } - if (h == 0) - { - outText (doP, (const char *) "void", 4); - } - mcPretty_print (doP, (const char *) ")", 1); - if ((n->procedureF.noreturn && prototype) && (! (mcOptions_getSuppressNoReturn ()))) - { - mcPretty_setNeedSpace (doP); - outText (doP, (const char *) "__attribute__ ((noreturn))", 26); - } -} - - -/* - checkDeclareUnboundedParamCopyC - -*/ - -static unsigned int checkDeclareUnboundedParamCopyC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - unsigned int i; - unsigned int c; - wlists_wlist l; - unsigned int seen; - - seen = FALSE; - t = decl_getType (n); - l = n->paramF.namelist->identlistF.names; - if (((decl_isArray (t)) && (decl_isUnbounded (t))) && (l != NULL)) - { - t = decl_getType (t); - c = wlists_noOfItemsInList (l); - i = 1; - while (i <= c) - { - doTypeNameC (p, t); - mcPretty_setNeedSpace (p); - doNamesC (p, wlists_getItemFromList (l, i)); - outText (p, (const char *) "[_", 2); - doNamesC (p, wlists_getItemFromList (l, i)); - outText (p, (const char *) "_high+1];\\n", 11); - seen = TRUE; - i += 1; - } - } - return seen; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkUnboundedParamCopyC - -*/ - -static void checkUnboundedParamCopyC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - decl_node s; - unsigned int i; - unsigned int c; - wlists_wlist l; - - t = decl_getType (n); - l = n->paramF.namelist->identlistF.names; - if (((decl_isArray (t)) && (decl_isUnbounded (t))) && (l != NULL)) - { - c = wlists_noOfItemsInList (l); - i = 1; - t = decl_getType (t); - s = decl_skipType (t); - while (i <= c) - { - keyc_useMemcpy (); - outText (p, (const char *) "memcpy (", 8); - doNamesC (p, wlists_getItemFromList (l, i)); - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - doNamesC (p, wlists_getItemFromList (l, i)); - outText (p, (const char *) "_, ", 3); - if (((s == charN) || (s == byteN)) || (s == locN)) - { - outText (p, (const char *) "_", 1); - doNamesC (p, wlists_getItemFromList (l, i)); - outText (p, (const char *) "_high+1);\\n", 11); - } - else - { - outText (p, (const char *) "(_", 2); - doNamesC (p, wlists_getItemFromList (l, i)); - outText (p, (const char *) "_high+1)", 8); - mcPretty_setNeedSpace (p); - doMultiplyBySize (p, t); - outText (p, (const char *) ");\\n", 4); - } - i += 1; - } - } -} - - -/* - doUnboundedParamCopyC - -*/ - -static void doUnboundedParamCopyC (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node q; - unsigned int seen; - - mcDebug_assert (decl_isProcedure (n)); - i = Indexing_LowIndice (n->procedureF.parameters); - h = Indexing_HighIndice (n->procedureF.parameters); - seen = FALSE; - while (i <= h) - { - q = static_cast (Indexing_GetIndice (n->procedureF.parameters, i)); - if (decl_isParam (q)) - { - seen = (checkDeclareUnboundedParamCopyC (p, q)) || seen; - } - i += 1; - } - if (seen) - { - outText (p, (const char *) "\\n", 2); - outText (p, (const char *) "/* make a local copy of each unbounded array. */\\n", 51); - i = Indexing_LowIndice (n->procedureF.parameters); - while (i <= h) - { - q = static_cast (Indexing_GetIndice (n->procedureF.parameters, i)); - if (decl_isParam (q)) - { - checkUnboundedParamCopyC (p, q); - } - i += 1; - } - } -} - - -/* - doPrototypeC - -*/ - -static void doPrototypeC (decl_node n) -{ - if (! (decl_isExported (n))) - { - keyc_enterScope (n); - doProcedureHeadingC (n, TRUE); - mcPretty_print (doP, (const char *) ";\\n", 3); - keyc_leaveScope (n); - } -} - - -/* - addTodo - adds, n, to the todo list. -*/ - -static void addTodo (decl_node n) -{ - if (((n != NULL) && (! (alists_isItemInList (partialQ, reinterpret_cast (n))))) && (! (alists_isItemInList (doneQ, reinterpret_cast (n))))) - { - mcDebug_assert (! (decl_isVarient (n))); - mcDebug_assert (! (decl_isVarientField (n))); - mcDebug_assert (! (decl_isDef (n))); - alists_includeItemIntoList (todoQ, reinterpret_cast (n)); - } -} - - -/* - addVariablesTodo - -*/ - -static void addVariablesTodo (decl_node n) -{ - if (decl_isVar (n)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (n->varF.isParameter || n->varF.isVarParameter) - { - addDone (n); - addTodo (decl_getType (n)); - } - else - { - addTodo (n); - } - } -} - - -/* - addTypesTodo - -*/ - -static void addTypesTodo (decl_node n) -{ - if (decl_isUnbounded (n)) - { - addDone (n); - } - else - { - addTodo (n); - } -} - - -/* - tempName - -*/ - -static DynamicStrings_String tempName (void) -{ - tempCount += 1; - return FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "_T%d", 4), (const unsigned char *) &tempCount, (sizeof (tempCount)-1)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeIntermediateType - -*/ - -static decl_node makeIntermediateType (DynamicStrings_String s, decl_node p) -{ - nameKey_Name n; - decl_node o; - - n = nameKey_makekey (DynamicStrings_string (s)); - decl_enterScope (decl_getScope (p)); - o = p; - p = decl_makeType (nameKey_makekey (DynamicStrings_string (s))); - decl_putType (p, o); - putTypeInternal (p); - decl_leaveScope (); - return p; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - simplifyType - -*/ - -static void simplifyType (alists_alist l, decl_node *p) -{ - DynamicStrings_String s; - - if ((((*p) != NULL) && (((decl_isRecord ((*p))) || (decl_isArray ((*p)))) || (decl_isProcType ((*p))))) && (! (decl_isUnbounded ((*p))))) - { - s = tempName (); - (*p) = makeIntermediateType (s, (*p)); - s = DynamicStrings_KillString (s); - simplified = FALSE; - } - simplifyNode (l, (*p)); -} - - -/* - simplifyVar - -*/ - -static void simplifyVar (alists_alist l, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node v; - decl_node d; - decl_node o; - - mcDebug_assert (decl_isVar (n)); - o = n->varF.type; - simplifyType (l, &n->varF.type); - if (o != n->varF.type) - { - /* simplification has occurred, make sure that all other variables of this type - use the new type. */ - d = n->varF.decl; - mcDebug_assert (isVarDecl (d)); - t = wlists_noOfItemsInList (d->vardeclF.names); - i = 1; - while (i <= t) - { - v = decl_lookupInScope (n->varF.scope, wlists_getItemFromList (d->vardeclF.names, i)); - mcDebug_assert (decl_isVar (v)); - v->varF.type = n->varF.type; - i += 1; - } - } -} - - -/* - simplifyRecord - -*/ - -static void simplifyRecord (alists_alist l, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - i = Indexing_LowIndice (n->recordF.listOfSons); - t = Indexing_HighIndice (n->recordF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); - simplifyNode (l, q); - i += 1; - } -} - - -/* - simplifyVarient - -*/ - -static void simplifyVarient (alists_alist l, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - simplifyNode (l, n->varientF.tag); - i = Indexing_LowIndice (n->varientF.listOfSons); - t = Indexing_HighIndice (n->varientF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); - simplifyNode (l, q); - i += 1; - } -} - - -/* - simplifyVarientField - -*/ - -static void simplifyVarientField (alists_alist l, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - i = Indexing_LowIndice (n->varientfieldF.listOfSons); - t = Indexing_HighIndice (n->varientfieldF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientfieldF.listOfSons, i)); - simplifyNode (l, q); - i += 1; - } -} - - -/* - doSimplifyNode - -*/ - -static void doSimplifyNode (alists_alist l, decl_node n) -{ - if (n == NULL) - {} /* empty. */ - else if (decl_isType (n)) - { - /* avoid dangling else. */ - /* no need to simplify a type. */ - simplifyNode (l, decl_getType (n)); - } - else if (decl_isVar (n)) - { - /* avoid dangling else. */ - simplifyVar (l, n); - } - else if (decl_isRecord (n)) - { - /* avoid dangling else. */ - simplifyRecord (l, n); - } - else if (decl_isRecordField (n)) - { - /* avoid dangling else. */ - simplifyType (l, &n->recordfieldF.type); - } - else if (decl_isArray (n)) - { - /* avoid dangling else. */ - simplifyType (l, &n->arrayF.type); - } - else if (decl_isVarient (n)) - { - /* avoid dangling else. */ - simplifyVarient (l, n); - } - else if (decl_isVarientField (n)) - { - /* avoid dangling else. */ - simplifyVarientField (l, n); - } - else if (decl_isPointer (n)) - { - /* avoid dangling else. */ - simplifyType (l, &n->pointerF.type); - } -} - - -/* - simplifyNode - -*/ - -static void simplifyNode (alists_alist l, decl_node n) -{ - if (! (alists_isItemInList (l, reinterpret_cast (n)))) - { - alists_includeItemIntoList (l, reinterpret_cast (n)); - doSimplifyNode (l, n); - } -} - - -/* - doSimplify - -*/ - -static void doSimplify (decl_node n) -{ - alists_alist l; - - l = alists_initList (); - simplifyNode (l, n); - alists_killList (&l); -} - - -/* - simplifyTypes - -*/ - -static void simplifyTypes (decl_scopeT s) -{ - do { - simplified = TRUE; - Indexing_ForeachIndiceInIndexDo (s.types, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doSimplify}); - Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doSimplify}); - } while (! (simplified)); -} - - -/* - outDeclsDefC - -*/ - -static void outDeclsDefC (mcPretty_pretty p, decl_node n) -{ - decl_scopeT s; - - s = n->defF.decls; - simplifyTypes (s); - includeConstType (s); - doP = p; - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}); - /* try and output types, constants before variables and procedures. */ - includeDefVarProcedure (n); - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}); - Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); -} - - -/* - includeConstType - -*/ - -static void includeConstType (decl_scopeT s) -{ - Indexing_ForeachIndiceInIndexDo (s.constants, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo}); - Indexing_ForeachIndiceInIndexDo (s.types, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTypesTodo}); -} - - -/* - includeVarProcedure - -*/ - -static void includeVarProcedure (decl_scopeT s) -{ - Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo}); - Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addVariablesTodo}); -} - - -/* - includeVar - -*/ - -static void includeVar (decl_scopeT s) -{ - Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo}); -} - - -/* - includeExternals - -*/ - -static void includeExternals (decl_node n) -{ - alists_alist l; - - l = alists_initList (); - visitNode (l, n, (decl_nodeProcedure) {(decl_nodeProcedure_t) addExported}); - alists_killList (&l); -} - - -/* - checkSystemInclude - -*/ - -static void checkSystemInclude (decl_node n) -{ -} - - -/* - addExported - -*/ - -static void addExported (decl_node n) -{ - decl_node s; - - s = decl_getScope (n); - if (((s != NULL) && (decl_isDef (s))) && (s != defModule)) - { - if (((decl_isType (n)) || (decl_isVar (n))) || (decl_isConst (n))) - { - addTodo (n); - } - } -} - - -/* - addExternal - only adds, n, if this symbol is external to the - implementation module and is not a hidden type. -*/ - -static void addExternal (decl_node n) -{ - if (((((decl_getScope (n)) == defModule) && (decl_isType (n))) && (decl_isTypeHidden (n))) && (! (mcOptions_getExtendedOpaque ()))) - {} /* empty. */ - /* do nothing. */ - else if (! (decl_isDef (n))) - { - /* avoid dangling else. */ - addTodo (n); - } -} - - -/* - includeDefConstType - -*/ - -static void includeDefConstType (decl_node n) -{ - decl_node d; - - if (decl_isImp (n)) - { - defModule = decl_lookupDef (decl_getSymName (n)); - if (defModule != NULL) - { - simplifyTypes (defModule->defF.decls); - includeConstType (defModule->defF.decls); - symbolKey_foreachNodeDo (defModule->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addExternal}); - } - } -} - - -/* - runIncludeDefConstType - -*/ - -static void runIncludeDefConstType (decl_node n) -{ - decl_node d; - - if (decl_isDef (n)) - { - simplifyTypes (n->defF.decls); - includeConstType (n->defF.decls); - symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addExternal}); - } -} - - -/* - joinProcedures - copies procedures from definition module, - d, into implementation module, i. -*/ - -static void joinProcedures (decl_node i, decl_node d) -{ - unsigned int h; - unsigned int j; - - mcDebug_assert (decl_isDef (d)); - mcDebug_assert (decl_isImp (i)); - j = 1; - h = Indexing_HighIndice (d->defF.decls.procedures); - while (j <= h) - { - Indexing_IncludeIndiceIntoIndex (i->impF.decls.procedures, Indexing_GetIndice (d->defF.decls.procedures, j)); - j += 1; - } -} - - -/* - includeDefVarProcedure - -*/ - -static void includeDefVarProcedure (decl_node n) -{ - decl_node d; - - if (decl_isImp (n)) - { - /* avoid dangling else. */ - defModule = decl_lookupDef (decl_getSymName (n)); - if (defModule != NULL) - { - /* - includeVar (defModule^.defF.decls) ; - simplifyTypes (defModule^.defF.decls) ; - */ - joinProcedures (n, defModule); - } - } - else if (decl_isDef (n)) - { - /* avoid dangling else. */ - includeVar (n->defF.decls); - simplifyTypes (n->defF.decls); - } -} - - -/* - foreachModuleDo - -*/ - -static void foreachModuleDo (decl_node n, symbolKey_performOperation p) -{ - decl_foreachDefModuleDo (p); - decl_foreachModModuleDo (p); -} - - -/* - outDeclsImpC - -*/ - -static void outDeclsImpC (mcPretty_pretty p, decl_scopeT s) -{ - simplifyTypes (s); - includeConstType (s); - doP = p; - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}); - /* try and output types, constants before variables and procedures. */ - includeVarProcedure (s); - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}); -} - - -/* - doStatementSequenceC - -*/ - -static void doStatementSequenceC (mcPretty_pretty p, decl_node s) -{ - unsigned int i; - unsigned int h; - - mcDebug_assert (decl_isStatementSequence (s)); - h = Indexing_HighIndice (s->stmtF.statements); - i = 1; - while (i <= h) - { - doStatementsC (p, reinterpret_cast (Indexing_GetIndice (s->stmtF.statements, i))); - i += 1; - } -} - - -/* - isStatementSequenceEmpty - -*/ - -static unsigned int isStatementSequenceEmpty (decl_node s) -{ - mcDebug_assert (decl_isStatementSequence (s)); - return (Indexing_HighIndice (s->stmtF.statements)) == 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isSingleStatement - returns TRUE if the statement sequence, s, has - only one statement. -*/ - -static unsigned int isSingleStatement (decl_node s) -{ - unsigned int h; - - mcDebug_assert (decl_isStatementSequence (s)); - h = Indexing_HighIndice (s->stmtF.statements); - if ((h == 0) || (h > 1)) - { - return FALSE; - } - s = static_cast (Indexing_GetIndice (s->stmtF.statements, 1)); - return (! (decl_isStatementSequence (s))) || (isSingleStatement (s)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doCommentC - -*/ - -static void doCommentC (mcPretty_pretty p, decl_node s) -{ - DynamicStrings_String c; - - if (s != NULL) - { - mcDebug_assert (isComment (s)); - if (! (mcComment_isProcedureComment (s->commentF.content))) - { - if (mcComment_isAfterComment (s->commentF.content)) - { - mcPretty_setNeedSpace (p); - outText (p, (const char *) " /* ", 4); - } - else - { - outText (p, (const char *) "/* ", 3); - } - c = mcComment_getContent (s->commentF.content); - c = DynamicStrings_RemoveWhitePrefix (DynamicStrings_RemoveWhitePostfix (c)); - outTextS (p, c); - outText (p, (const char *) " */\\n", 6); - } - } -} - - -/* - doAfterCommentC - emit an after comment, c, or a newline if, c, is empty. -*/ - -static void doAfterCommentC (mcPretty_pretty p, decl_node c) -{ - if (c == NULL) - { - outText (p, (const char *) "\\n", 2); - } - else - { - doCommentC (p, c); - } -} - - -/* - doReturnC - issue a return statement and also place in an after comment if one exists. -*/ - -static void doReturnC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (decl_isReturn (s)); - doCommentC (p, s->returnF.returnComment.body); - outText (p, (const char *) "return", 6); - if (s->returnF.scope != NULL) - { - mcPretty_setNeedSpace (p); - if ((! (decl_isProcedure (s->returnF.scope))) || ((decl_getType (s->returnF.scope)) == NULL)) - { - mcMetaError_metaError1 ((const char *) "{%1DMad} has no return type", 27, (const unsigned char *) &s->returnF.scope, (sizeof (s->returnF.scope)-1)); - } - else - { - doExprCastC (p, s->returnF.exp, decl_getType (s->returnF.scope)); - } - } - outText (p, (const char *) ";", 1); - doAfterCommentC (p, s->returnF.returnComment.after); -} - - -/* - isZtypeEquivalent - -*/ - -static unsigned int isZtypeEquivalent (decl_node type) -{ - switch (type->kind) - { - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_ztype: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isEquivalentType - returns TRUE if type1 and type2 are equivalent. -*/ - -static unsigned int isEquivalentType (decl_node type1, decl_node type2) -{ - type1 = decl_skipType (type1); - type2 = decl_skipType (type2); - return (type1 == type2) || ((isZtypeEquivalent (type1)) && (isZtypeEquivalent (type2))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doExprCastC - build a cast if necessary. -*/ - -static void doExprCastC (mcPretty_pretty p, decl_node e, decl_node type) -{ - decl_node stype; - - stype = decl_skipType (type); - if ((! (isEquivalentType (type, getExprType (e)))) && (! ((e->kind == decl_nil) && ((decl_isPointer (stype)) || (stype->kind == decl_address))))) - { - if (lang == decl_ansiCP) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* potentially a cast is required. */ - if ((decl_isPointer (type)) || (type == addressN)) - { - outText (p, (const char *) "reinterpret_cast<", 17); - doTypeNameC (p, type); - mcPretty_noSpace (p); - outText (p, (const char *) "> (", 3); - doExprC (p, e); - outText (p, (const char *) ")", 1); - return ; - } - else - { - outText (p, (const char *) "static_cast<", 12); - if (decl_isProcType (decl_skipType (type))) - { - doTypeNameC (p, type); - outText (p, (const char *) "_t", 2); - } - else - { - doTypeNameC (p, type); - } - mcPretty_noSpace (p); - outText (p, (const char *) "> (", 3); - doExprC (p, e); - outText (p, (const char *) ")", 1); - return ; - } - } - } - doExprC (p, e); -} - - -/* - requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ. -*/ - -static unsigned int requiresUnpackProc (decl_node s) -{ - mcDebug_assert (isAssignment (s)); - return (decl_isProcedure (s->assignmentF.expr)) || ((decl_skipType (decl_getType (s->assignmentF.des))) != (decl_skipType (decl_getType (s->assignmentF.expr)))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doAssignmentC - -*/ - -static void doAssignmentC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (isAssignment (s)); - doCommentC (p, s->assignmentF.assignComment.body); - doExprCup (p, s->assignmentF.des, requiresUnpackProc (s)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "=", 1); - mcPretty_setNeedSpace (p); - doExprCastC (p, s->assignmentF.expr, decl_getType (s->assignmentF.des)); - outText (p, (const char *) ";", 1); - doAfterCommentC (p, s->assignmentF.assignComment.after); -} - - -/* - containsStatement - -*/ - -static unsigned int containsStatement (decl_node s) -{ - return ((s != NULL) && (decl_isStatementSequence (s))) && (! (isStatementSequenceEmpty (s))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doCompoundStmt - -*/ - -static void doCompoundStmt (mcPretty_pretty p, decl_node s) -{ - if ((s == NULL) || ((decl_isStatementSequence (s)) && (isStatementSequenceEmpty (s)))) - { - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "{} /* empty. */\\n", 19); - p = mcPretty_popPretty (p); - } - else if (((decl_isStatementSequence (s)) && (isSingleStatement (s))) && ! forceCompoundStatement) - { - /* avoid dangling else. */ - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doStatementSequenceC (p, s); - p = mcPretty_popPretty (p); - } - else - { - /* avoid dangling else. */ - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "{\\n", 3); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doStatementSequenceC (p, s); - p = mcPretty_popPretty (p); - outText (p, (const char *) "}\\n", 3); - p = mcPretty_popPretty (p); - } -} - - -/* - doElsifC - -*/ - -static void doElsifC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (decl_isElsif (s)); - outText (p, (const char *) "else if", 7); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, s->elsifF.expr); - outText (p, (const char *) ")\\n", 3); - mcDebug_assert ((s->elsifF.else_ == NULL) || (s->elsifF.elsif == NULL)); - if (forceCompoundStatement || ((hasIfAndNoElse (s->elsifF.then)) && ((s->elsifF.else_ != NULL) || (s->elsifF.elsif != NULL)))) - { - /* avoid dangling else. */ - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "{\\n", 3); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "/* avoid dangling else. */\\n", 29); - doStatementSequenceC (p, s->elsifF.then); - p = mcPretty_popPretty (p); - outText (p, (const char *) "}\\n", 3); - p = mcPretty_popPretty (p); - } - else - { - doCompoundStmt (p, s->elsifF.then); - } - if (containsStatement (s->elsifF.else_)) - { - outText (p, (const char *) "else\\n", 6); - if (forceCompoundStatement) - { - /* avoid dangling else. */ - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "{\\n", 3); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "/* avoid dangling else. */\\n", 29); - doStatementSequenceC (p, s->elsifF.else_); - p = mcPretty_popPretty (p); - outText (p, (const char *) "}\\n", 3); - p = mcPretty_popPretty (p); - } - else - { - doCompoundStmt (p, s->elsifF.else_); - } - } - else if ((s->elsifF.elsif != NULL) && (decl_isElsif (s->elsifF.elsif))) - { - /* avoid dangling else. */ - doElsifC (p, s->elsifF.elsif); - } -} - - -/* - noIfElse - -*/ - -static unsigned int noIfElse (decl_node n) -{ - return (((n != NULL) && (decl_isIf (n))) && (n->ifF.else_ == NULL)) && (n->ifF.elsif == NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - noIfElseChained - returns TRUE if, n, is an IF statement which - has no associated ELSE statement. An IF with an - ELSIF is also checked for no ELSE and will result - in a return value of TRUE. -*/ - -static unsigned int noIfElseChained (decl_node n) -{ - decl_node e; - - if (n != NULL) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (decl_isIf (n)) - { - if (n->ifF.else_ != NULL) - { - /* we do have an else, continue to check this statement. */ - return hasIfAndNoElse (n->ifF.else_); - } - else if (n->ifF.elsif == NULL) - { - /* avoid dangling else. */ - /* neither else or elsif. */ - return TRUE; - } - else - { - /* avoid dangling else. */ - /* test elsif for lack of else. */ - e = n->ifF.elsif; - mcDebug_assert (decl_isElsif (e)); - return noIfElseChained (e); - } - } - else if (decl_isElsif (n)) - { - /* avoid dangling else. */ - if (n->elsifF.else_ != NULL) - { - /* we do have an else, continue to check this statement. */ - return hasIfAndNoElse (n->elsifF.else_); - } - else if (n->elsifF.elsif == NULL) - { - /* avoid dangling else. */ - /* neither else or elsif. */ - return TRUE; - } - else - { - /* avoid dangling else. */ - /* test elsif for lack of else. */ - e = n->elsifF.elsif; - mcDebug_assert (decl_isElsif (e)); - return noIfElseChained (e); - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - hasIfElse - -*/ - -static unsigned int hasIfElse (decl_node n) -{ - if (n != NULL) - { - if (decl_isStatementSequence (n)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (isStatementSequenceEmpty (n)) - { - return FALSE; - } - else if (isSingleStatement (n)) - { - /* avoid dangling else. */ - n = static_cast (Indexing_GetIndice (n->stmtF.statements, 1)); - return isIfElse (n); - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isIfElse - -*/ - -static unsigned int isIfElse (decl_node n) -{ - return ((n != NULL) && (decl_isIf (n))) && ((n->ifF.else_ != NULL) || (n->ifF.elsif != NULL)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - hasIfAndNoElse - returns TRUE if statement, n, is a single statement - which is an IF and it has no else statement. -*/ - -static unsigned int hasIfAndNoElse (decl_node n) -{ - if (n != NULL) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (decl_isStatementSequence (n)) - { - if (isStatementSequenceEmpty (n)) - { - return FALSE; - } - else if (isSingleStatement (n)) - { - /* avoid dangling else. */ - n = static_cast (Indexing_GetIndice (n->stmtF.statements, 1)); - return hasIfAndNoElse (n); - } - else - { - /* avoid dangling else. */ - n = static_cast (Indexing_GetIndice (n->stmtF.statements, Indexing_HighIndice (n->stmtF.statements))); - return hasIfAndNoElse (n); - } - } - else if ((decl_isElsif (n)) || (decl_isIf (n))) - { - /* avoid dangling else. */ - return noIfElseChained (n); - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doIfC - issue an if statement and also place in an after comment if one exists. - The if statement might contain an else or elsif which are also handled. -*/ - -static void doIfC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (decl_isIf (s)); - doCommentC (p, s->ifF.ifComment.body); - outText (p, (const char *) "if", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, s->ifF.expr); - outText (p, (const char *) ")", 1); - doAfterCommentC (p, s->ifF.ifComment.after); - if ((hasIfAndNoElse (s->ifF.then)) && ((s->ifF.else_ != NULL) || (s->ifF.elsif != NULL))) - { - /* avoid dangling else. */ - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "{\\n", 3); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "/* avoid dangling else. */\\n", 29); - doStatementSequenceC (p, s->ifF.then); - p = mcPretty_popPretty (p); - outText (p, (const char *) "}\\n", 3); - p = mcPretty_popPretty (p); - } - else if ((noIfElse (s)) && (hasIfElse (s->ifF.then))) - { - /* avoid dangling else. */ - /* gcc does not like legal non dangling else, as it is poor style. - So we will avoid getting a warning. */ - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "{\\n", 3); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - outText (p, (const char *) "/* avoid gcc warning by using compound statement even if not strictly necessary. */\\n", 86); - doStatementSequenceC (p, s->ifF.then); - p = mcPretty_popPretty (p); - outText (p, (const char *) "}\\n", 3); - p = mcPretty_popPretty (p); - } - else - { - /* avoid dangling else. */ - doCompoundStmt (p, s->ifF.then); - } - mcDebug_assert ((s->ifF.else_ == NULL) || (s->ifF.elsif == NULL)); - if (containsStatement (s->ifF.else_)) - { - doCommentC (p, s->ifF.elseComment.body); - outText (p, (const char *) "else", 4); - doAfterCommentC (p, s->ifF.elseComment.after); - doCompoundStmt (p, s->ifF.else_); - } - else if ((s->ifF.elsif != NULL) && (decl_isElsif (s->ifF.elsif))) - { - /* avoid dangling else. */ - doCommentC (p, s->ifF.elseComment.body); - doCommentC (p, s->ifF.elseComment.after); - doElsifC (p, s->ifF.elsif); - } - doCommentC (p, s->ifF.endComment.after); - doCommentC (p, s->ifF.endComment.body); -} - - -/* - doForIncCP - -*/ - -static void doForIncCP (mcPretty_pretty p, decl_node s) -{ - decl_node t; - - mcDebug_assert (decl_isFor (s)); - t = decl_skipType (decl_getType (s->forF.des)); - if (decl_isEnumeration (t)) - { - if (s->forF.increment == NULL) - { - doExprC (p, s->forF.des); - outText (p, (const char *) "= static_cast<", 14); - doTypeNameC (p, decl_getType (s->forF.des)); - mcPretty_noSpace (p); - outText (p, (const char *) ">(static_cast(", 19); - doExprC (p, s->forF.des); - outText (p, (const char *) "+1))", 4); - } - else - { - doExprC (p, s->forF.des); - outText (p, (const char *) "= static_cast<", 14); - doTypeNameC (p, decl_getType (s->forF.des)); - mcPretty_noSpace (p); - outText (p, (const char *) ">(static_cast(", 19); - doExprC (p, s->forF.des); - outText (p, (const char *) "+", 1); - doExprC (p, s->forF.increment); - outText (p, (const char *) "))", 2); - } - } - else - { - doForIncC (p, s); - } -} - - -/* - doForIncC - -*/ - -static void doForIncC (mcPretty_pretty p, decl_node s) -{ - if (s->forF.increment == NULL) - { - doExprC (p, s->forF.des); - outText (p, (const char *) "++", 2); - } - else - { - doExprC (p, s->forF.des); - outText (p, (const char *) "=", 1); - doExprC (p, s->forF.des); - outText (p, (const char *) "+", 1); - doExprC (p, s->forF.increment); - } -} - - -/* - doForInc - -*/ - -static void doForInc (mcPretty_pretty p, decl_node s) -{ - if (lang == decl_ansiCP) - { - doForIncCP (p, s); - } - else - { - doForIncC (p, s); - } -} - - -/* - doForC - -*/ - -static void doForC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (decl_isFor (s)); - outText (p, (const char *) "for (", 5); - doExprC (p, s->forF.des); - outText (p, (const char *) "=", 1); - doExprC (p, s->forF.start); - outText (p, (const char *) ";", 1); - mcPretty_setNeedSpace (p); - doExprC (p, s->forF.des); - outText (p, (const char *) "<=", 2); - doExprC (p, s->forF.end); - outText (p, (const char *) ";", 1); - mcPretty_setNeedSpace (p); - doForInc (p, s); - outText (p, (const char *) ")\\n", 3); - doCompoundStmt (p, s->forF.statements); -} - - -/* - doRepeatC - -*/ - -static void doRepeatC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (decl_isRepeat (s)); - doCommentC (p, s->repeatF.repeatComment.body); - outText (p, (const char *) "do {", 4); - doAfterCommentC (p, s->repeatF.repeatComment.after); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doStatementSequenceC (p, s->repeatF.statements); - doCommentC (p, s->repeatF.untilComment.body); - p = mcPretty_popPretty (p); - outText (p, (const char *) "} while (! (", 12); - doExprC (p, s->repeatF.expr); - outText (p, (const char *) "));", 3); - doAfterCommentC (p, s->repeatF.untilComment.after); -} - - -/* - doWhileC - -*/ - -static void doWhileC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (decl_isWhile (s)); - doCommentC (p, s->whileF.doComment.body); - outText (p, (const char *) "while (", 7); - doExprC (p, s->whileF.expr); - outText (p, (const char *) ")", 1); - doAfterCommentC (p, s->whileF.doComment.after); - doCompoundStmt (p, s->whileF.statements); - doCommentC (p, s->whileF.endComment.body); - doCommentC (p, s->whileF.endComment.after); -} - - -/* - doFuncHighC - -*/ - -static void doFuncHighC (mcPretty_pretty p, decl_node a) -{ - decl_node s; - decl_node n; - - if ((decl_isLiteral (a)) && ((decl_getType (a)) == charN)) - { - outCard (p, 0); - } - else if (isString (a)) - { - /* avoid dangling else. */ - outCard (p, a->stringF.length-2); - } - else if ((decl_isConst (a)) && (isString (a->constF.value))) - { - /* avoid dangling else. */ - doFuncHighC (p, a->constF.value); - } - else if (decl_isUnbounded (decl_getType (a))) - { - /* avoid dangling else. */ - outText (p, (const char *) "_", 1); - outTextN (p, decl_getSymName (a)); - outText (p, (const char *) "_high", 5); - } - else if (decl_isArray (decl_skipType (decl_getType (a)))) - { - /* avoid dangling else. */ - n = decl_skipType (decl_getType (a)); - s = n->arrayF.subr; - if (isZero (getMin (s))) - { - doExprC (p, getMax (s)); - } - else - { - outText (p, (const char *) "(", 1); - doExprC (p, getMax (s)); - doSubtractC (p, getMin (s)); - outText (p, (const char *) ")", 1); - } - } - else - { - /* avoid dangling else. */ - /* output sizeof (a) in bytes for the high. */ - outText (p, (const char *) "(sizeof", 7); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, a); - outText (p, (const char *) ")-1)", 4); - } -} - - -/* - doMultiplyBySize - -*/ - -static void doMultiplyBySize (mcPretty_pretty p, decl_node a) -{ - if (((a != charN) && (a != byteN)) && (a != locN)) - { - mcPretty_setNeedSpace (p); - outText (p, (const char *) "* sizeof (", 10); - doTypeNameC (p, a); - mcPretty_noSpace (p); - outText (p, (const char *) ")", 1); - } -} - - -/* - doTotype - -*/ - -static void doTotype (mcPretty_pretty p, decl_node a, decl_node t) -{ - if ((! (isString (a))) && (! (decl_isLiteral (a)))) - { - if (decl_isVar (a)) - { - if (((a->varF.isParameter || a->varF.isVarParameter) && (decl_isUnbounded (decl_getType (a)))) && ((decl_skipType (decl_getType (decl_getType (a)))) == (decl_skipType (decl_getType (t))))) - { - /* do not multiply by size as the existing high value is correct. */ - return ; - } - a = decl_getType (a); - if (decl_isArray (a)) - { - doMultiplyBySize (p, decl_skipType (decl_getType (a))); - } - } - } - if (t == wordN) - { - mcPretty_setNeedSpace (p); - outText (p, (const char *) "/ sizeof (", 10); - doTypeNameC (p, wordN); - mcPretty_noSpace (p); - outText (p, (const char *) ")", 1); - } -} - - -/* - doFuncUnbounded - -*/ - -static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node formalParam, decl_node formal, decl_node func) -{ - decl_node h; - DynamicStrings_String s; - - mcDebug_assert (decl_isUnbounded (formal)); - outText (p, (const char *) "(", 1); - if ((lang == decl_ansiCP) && (decl_isParam (formalParam))) - { - outText (p, (const char *) "const", 5); - mcPretty_setNeedSpace (p); - } - doTypeC (p, decl_getType (formal), &formal); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "*)", 2); - mcPretty_setNeedSpace (p); - if ((decl_isLiteral (actual)) && ((decl_getType (actual)) == charN)) - { - outText (p, (const char *) "\"\\0", 3); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (actual->literalF.name)); - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1); - outTextS (p, s); - outText (p, (const char *) "\"", 1); - s = DynamicStrings_KillString (s); - } - else if (isString (actual)) - { - /* avoid dangling else. */ - outCstring (p, actual, TRUE); - } - else if (decl_isConst (actual)) - { - /* avoid dangling else. */ - actual = resolveString (actual); - mcDebug_assert (isString (actual)); - outCstring (p, actual, TRUE); - } - else if (isFuncCall (actual)) - { - /* avoid dangling else. */ - if ((getExprType (actual)) == NULL) - { - mcMetaError_metaError3 ((const char *) "there is no return type to the procedure function {%3ad} which is being passed as the parameter {%1ad} to {%2ad}", 112, (const unsigned char *) &formal, (sizeof (formal)-1), (const unsigned char *) &func, (sizeof (func)-1), (const unsigned char *) &actual, (sizeof (actual)-1)); - } - else - { - outText (p, (const char *) "&", 1); - doExprC (p, actual); - } - } - else if (decl_isUnbounded (decl_getType (actual))) - { - /* avoid dangling else. */ - /* doExprC (p, actual). */ - doFQNameC (p, actual); - } - else - { - /* avoid dangling else. */ - outText (p, (const char *) "&", 1); - doExprC (p, actual); - if (decl_isArray (decl_skipType (decl_getType (actual)))) - { - outText (p, (const char *) ".array[0]", 9); - } - } - if (! (enableDefForCStrings && (isDefForC (decl_getScope (func))))) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - doFuncHighC (p, actual); - doTotype (p, actual, formal); - } -} - - -/* - doProcedureParamC - -*/ - -static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal) -{ - if (isForC (formal)) - { - outText (p, (const char *) "(", 1); - doFQNameC (p, decl_getType (formal)); - outText (p, (const char *) "_C", 2); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - doExprC (p, actual); - } - else - { - outText (p, (const char *) "(", 1); - doTypeNameC (p, decl_getType (formal)); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "{", 1); - outText (p, (const char *) "(", 1); - doFQNameC (p, decl_getType (formal)); - outText (p, (const char *) "_t)", 3); - mcPretty_setNeedSpace (p); - doExprC (p, actual); - outText (p, (const char *) "}", 1); - } -} - - -/* - doAdrExprC - -*/ - -static void doAdrExprC (mcPretty_pretty p, decl_node n) -{ - if (isDeref (n)) - { - /* no point in issuing & ( * n ) */ - doExprC (p, n->unaryF.arg); - } - else if ((decl_isVar (n)) && n->varF.isVarParameter) - { - /* avoid dangling else. */ - /* no point in issuing & ( * n ) */ - doFQNameC (p, n); - } - else - { - /* avoid dangling else. */ - outText (p, (const char *) "&", 1); - doExprC (p, n); - } -} - - -/* - typePair - -*/ - -static unsigned int typePair (decl_node a, decl_node b, decl_node x, decl_node y) -{ - return ((a == x) && (b == y)) || ((a == y) && (b == x)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - needsCast - return TRUE if the actual type parameter needs to be cast to - the formal type. -*/ - -static unsigned int needsCast (decl_node at, decl_node ft) -{ - at = decl_skipType (at); - ft = decl_skipType (ft); - if (((((((((((((at == nilN) || (at->kind == decl_nil)) || (at == ft)) || (typePair (at, ft, cardinalN, wordN))) || (typePair (at, ft, cardinalN, ztypeN))) || (typePair (at, ft, integerN, ztypeN))) || (typePair (at, ft, longcardN, ztypeN))) || (typePair (at, ft, shortcardN, ztypeN))) || (typePair (at, ft, longintN, ztypeN))) || (typePair (at, ft, shortintN, ztypeN))) || (typePair (at, ft, realN, rtypeN))) || (typePair (at, ft, longrealN, rtypeN))) || (typePair (at, ft, shortrealN, rtypeN))) - { - return FALSE; - } - else - { - return TRUE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkSystemCast - checks to see if we are passing to/from - a system generic type (WORD, BYTE, ADDRESS) - and if so emit a cast. It returns the number of - open parenthesis. -*/ - -static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_node formal) -{ - decl_node at; - decl_node ft; - - at = getExprType (actual); - ft = decl_getType (formal); - if (needsCast (at, ft)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (lang == decl_ansiCP) - { - if ((isString (actual)) && ((decl_skipType (ft)) == addressN)) - { - outText (p, (const char *) "const_cast (reinterpret_cast (", 50); - return 2; - } - else if ((decl_isPointer (decl_skipType (ft))) || ((decl_skipType (ft)) == addressN)) - { - /* avoid dangling else. */ - if (actual == nilN) - { - if (decl_isVarParam (formal)) - { - mcMetaError_metaError1 ((const char *) "NIL is being passed to a VAR parameter {%1DMad}", 47, (const unsigned char *) &formal, (sizeof (formal)-1)); - } - /* NULL is compatible with pointers/address. */ - return 0; - } - else - { - outText (p, (const char *) "reinterpret_cast<", 17); - doTypeNameC (p, ft); - if (decl_isVarParam (formal)) - { - outText (p, (const char *) "*", 1); - } - mcPretty_noSpace (p); - outText (p, (const char *) "> (", 3); - } - } - else - { - /* avoid dangling else. */ - outText (p, (const char *) "static_cast<", 12); - doTypeNameC (p, ft); - if (decl_isVarParam (formal)) - { - outText (p, (const char *) "*", 1); - } - mcPretty_noSpace (p); - outText (p, (const char *) "> (", 3); - } - return 1; - } - else - { - outText (p, (const char *) "(", 1); - doTypeNameC (p, ft); - if (decl_isVarParam (formal)) - { - outText (p, (const char *) "*", 1); - } - mcPretty_noSpace (p); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - } - } - return 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - emitN - -*/ - -static void emitN (mcPretty_pretty p, const char *a_, unsigned int _a_high, unsigned int n) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - while (n > 0) - { - outText (p, (const char *) a, _a_high); - n -= 1; - } -} - - -/* - isForC - return true if node n is a varparam, param or procedure - which was declared inside a definition module for "C". -*/ - -static unsigned int isForC (decl_node n) -{ - if (decl_isVarParam (n)) - { - return n->varparamF.isForC; - } - else if (decl_isParam (n)) - { - /* avoid dangling else. */ - return n->paramF.isForC; - } - else if (decl_isProcedure (n)) - { - /* avoid dangling else. */ - return n->procedureF.isForC; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isDefForCNode - return TRUE if node n was declared inside a definition module for "C". -*/ - -static unsigned int isDefForCNode (decl_node n) -{ - nameKey_Name name; - - while ((n != NULL) && (! (((decl_isImp (n)) || (decl_isDef (n))) || (decl_isModule (n))))) - { - n = decl_getScope (n); - } - if ((n != NULL) && (decl_isImp (n))) - { - name = decl_getSymName (n); - n = decl_lookupDef (name); - } - return ((n != NULL) && (decl_isDef (n))) && (isDefForC (n)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doFuncParamC - -*/ - -static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal, decl_node func) -{ - decl_node ft; - decl_node at; - unsigned int lbr; - - if (formal == NULL) - { - doExprC (p, actual); - } - else - { - ft = decl_skipType (decl_getType (formal)); - if (decl_isUnbounded (ft)) - { - doFuncUnbounded (p, actual, formal, ft, func); - } - else - { - if ((isAProcType (ft)) && (decl_isProcedure (actual))) - { - if (decl_isVarParam (formal)) - { - mcMetaError_metaError1 ((const char *) "{%1MDad} cannot be passed as a VAR parameter", 44, (const unsigned char *) &actual, (sizeof (actual)-1)); - } - else - { - doProcedureParamC (p, actual, formal); - } - } - else if (((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && (isAProcType (ft))) && (isForC (formal))) - { - /* avoid dangling else. */ - if (decl_isVarParam (formal)) - { - mcMetaError_metaError2 ((const char *) "{%1MDad} cannot be passed as a VAR parameter to the definition for C module as the parameter requires a cast to the formal type {%2MDtad}", 137, (const unsigned char *) &actual, (sizeof (actual)-1), (const unsigned char *) &formal, (sizeof (formal)-1)); - } - else - { - outText (p, (const char *) "(", 1); - doFQNameC (p, decl_getType (formal)); - outText (p, (const char *) "_C", 2); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - doExprC (p, actual); - outText (p, (const char *) ".proc", 5); - } - } - else if ((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && ((decl_getType (actual)) != (decl_getType (formal)))) - { - /* avoid dangling else. */ - if (decl_isVarParam (formal)) - { - mcMetaError_metaError2 ((const char *) "{%1MDad} cannot be passed as a VAR parameter as the parameter requires a cast to the formal type {%2MDtad}", 106, (const unsigned char *) &actual, (sizeof (actual)-1), (const unsigned char *) &formal, (sizeof (formal)-1)); - } - else - { - doCastC (p, decl_getType (formal), actual); - } - } - else - { - /* avoid dangling else. */ - lbr = checkSystemCast (p, actual, formal); - if (decl_isVarParam (formal)) - { - doAdrExprC (p, actual); - } - else - { - doExprC (p, actual); - } - emitN (p, (const char *) ")", 1, lbr); - } - } - } -} - - -/* - getNthParamType - return the type of parameter, i, in list, l. - If the parameter is a vararg NIL is returned. -*/ - -static decl_node getNthParamType (Indexing_Index l, unsigned int i) -{ - decl_node p; - - p = getNthParam (l, i); - if (p != NULL) - { - return decl_getType (p); - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getNthParam - return the parameter, i, in list, l. - If the parameter is a vararg NIL is returned. -*/ - -static decl_node getNthParam (Indexing_Index l, unsigned int i) -{ - decl_node p; - unsigned int j; - unsigned int k; - unsigned int h; - - if (l != NULL) - { - j = Indexing_LowIndice (l); - h = Indexing_HighIndice (l); - while (j <= h) - { - p = static_cast (Indexing_GetIndice (l, j)); - if (decl_isParam (p)) - { - k = identListLen (p->paramF.namelist); - } - else if (decl_isVarParam (p)) - { - /* avoid dangling else. */ - k = identListLen (p->varparamF.namelist); - } - else - { - /* avoid dangling else. */ - mcDebug_assert (decl_isVarargs (p)); - return NULL; - } - if (i <= k) - { - return p; - } - else - { - i -= k; - j += 1; - } - } - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doFuncArgsC - -*/ - -static void doFuncArgsC (mcPretty_pretty p, decl_node s, Indexing_Index l, unsigned int needParen) -{ - decl_node actual; - decl_node formal; - unsigned int i; - unsigned int n; - - if (needParen) - { - outText (p, (const char *) "(", 1); - } - if (s->funccallF.args != NULL) - { - i = 1; - n = expListLen (s->funccallF.args); - while (i <= n) - { - actual = getExpList (s->funccallF.args, i); - formal = getNthParam (l, i); - doFuncParamC (p, actual, formal, s->funccallF.function); - if (i < n) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - i += 1; - } - } - if (needParen) - { - mcPretty_noSpace (p); - outText (p, (const char *) ")", 1); - } -} - - -/* - doProcTypeArgsC - -*/ - -static void doProcTypeArgsC (mcPretty_pretty p, decl_node s, Indexing_Index args, unsigned int needParen) -{ - decl_node a; - decl_node b; - unsigned int i; - unsigned int n; - - if (needParen) - { - outText (p, (const char *) "(", 1); - } - if (s->funccallF.args != NULL) - { - i = 1; - n = expListLen (s->funccallF.args); - while (i <= n) - { - a = getExpList (s->funccallF.args, i); - b = static_cast (Indexing_GetIndice (args, i)); - doFuncParamC (p, a, b, s->funccallF.function); - if (i < n) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - i += 1; - } - } - if (needParen) - { - mcPretty_noSpace (p); - outText (p, (const char *) ")", 1); - } -} - - -/* - doAdrArgC - -*/ - -static void doAdrArgC (mcPretty_pretty p, decl_node n) -{ - if (isDeref (n)) - { - /* & and * cancel each other out. */ - doExprC (p, n->unaryF.arg); - } - else if ((decl_isVar (n)) && n->varF.isVarParameter) - { - /* avoid dangling else. */ - outTextN (p, decl_getSymName (n)); /* --fixme-- does the caller need to cast it? */ - } - else - { - /* avoid dangling else. */ - if (isString (n)) - { - if (lang == decl_ansiCP) - { - outText (p, (const char *) "const_cast (reinterpret_cast", 48); - outText (p, (const char *) "(", 1); - doExprC (p, n); - outText (p, (const char *) "))", 2); - } - else - { - doExprC (p, n); - } - } - else - { - outText (p, (const char *) "&", 1); - doExprC (p, n); - } - } -} - - -/* - doAdrC - -*/ - -static void doAdrC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isUnary (n)); - doAdrArgC (p, n->unaryF.arg); -} - - -/* - doInc - -*/ - -static void doInc (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isIntrinsic (n)); - if (lang == decl_ansiCP) - { - doIncDecCP (p, n, (const char *) "+", 1); - } - else - { - doIncDecC (p, n, (const char *) "+=", 2); - } -} - - -/* - doDec - -*/ - -static void doDec (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isIntrinsic (n)); - if (lang == decl_ansiCP) - { - doIncDecCP (p, n, (const char *) "-", 1); - } - else - { - doIncDecC (p, n, (const char *) "-=", 2); - } -} - - -/* - doIncDecC - -*/ - -static void doIncDecC (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high) -{ - char op[_op_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (op, op_, _op_high+1); - - mcDebug_assert (isIntrinsic (n)); - if (n->intrinsicF.args != NULL) - { - doExprC (p, getExpList (n->intrinsicF.args, 1)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) op, _op_high); - mcPretty_setNeedSpace (p); - if ((expListLen (n->intrinsicF.args)) == 1) - { - outText (p, (const char *) "1", 1); - } - else - { - doExprC (p, getExpList (n->intrinsicF.args, 2)); - } - } -} - - -/* - doIncDecCP - -*/ - -static void doIncDecCP (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high) -{ - decl_node lhs; - decl_node type; - char op[_op_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (op, op_, _op_high+1); - - mcDebug_assert (isIntrinsic (n)); - if (n->intrinsicF.args != NULL) - { - lhs = getExpList (n->intrinsicF.args, 1); - doExprC (p, lhs); - mcPretty_setNeedSpace (p); - type = decl_getType (lhs); - if ((decl_isPointer (type)) || (type == addressN)) - { - /* cast to (char * ) and then back again after the arithmetic is complete. */ - outText (p, (const char *) "=", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "reinterpret_cast<", 17); - doTypeNameC (p, type); - mcPretty_noSpace (p); - outText (p, (const char *) "> (reinterpret_cast (", 29); - doExprC (p, lhs); - mcPretty_noSpace (p); - outText (p, (const char *) ")", 1); - outText (p, (const char *) op, _op_high); - if ((expListLen (n->intrinsicF.args)) == 1) - { - outText (p, (const char *) "1", 1); - } - else - { - doExprC (p, getExpList (n->intrinsicF.args, 2)); - } - outText (p, (const char *) ")", 1); - } - else if (decl_isEnumeration (decl_skipType (type))) - { - /* avoid dangling else. */ - outText (p, (const char *) "= static_cast<", 14); - doTypeNameC (p, type); - mcPretty_noSpace (p); - outText (p, (const char *) ">(static_cast(", 19); - doExprC (p, lhs); - outText (p, (const char *) ")", 1); - outText (p, (const char *) op, _op_high); - if ((expListLen (n->intrinsicF.args)) == 1) - { - outText (p, (const char *) "1", 1); - } - else - { - doExprC (p, getExpList (n->intrinsicF.args, 2)); - } - outText (p, (const char *) ")", 1); - } - else - { - /* avoid dangling else. */ - outText (p, (const char *) op, _op_high); - outText (p, (const char *) "=", 1); - mcPretty_setNeedSpace (p); - if ((expListLen (n->intrinsicF.args)) == 1) - { - outText (p, (const char *) "1", 1); - } - else - { - doExprC (p, getExpList (n->intrinsicF.args, 2)); - } - } - } -} - - -/* - doInclC - -*/ - -static void doInclC (mcPretty_pretty p, decl_node n) -{ - decl_node lo; - - mcDebug_assert (isIntrinsic (n)); - if (n->intrinsicF.args != NULL) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((expListLen (n->intrinsicF.args)) == 2) - { - doExprC (p, getExpList (n->intrinsicF.args, 1)); - lo = getSetLow (getExpList (n->intrinsicF.args, 1)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "|=", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(1", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "<<", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, getExpList (n->intrinsicF.args, 2)); - doSubtractC (p, lo); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "))", 2); - } - else - { - M2RTS_HALT (-1); /* metaError0 ('expecting two parameters to INCL') */ - __builtin_unreachable (); - } - } -} - - -/* - doExclC - -*/ - -static void doExclC (mcPretty_pretty p, decl_node n) -{ - decl_node lo; - - mcDebug_assert (isIntrinsic (n)); - if (n->intrinsicF.args != NULL) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((expListLen (n->intrinsicF.args)) == 2) - { - doExprC (p, getExpList (n->intrinsicF.args, 1)); - lo = getSetLow (getExpList (n->intrinsicF.args, 1)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "&=", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(~(1", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "<<", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, getExpList (n->intrinsicF.args, 2)); - doSubtractC (p, lo); - mcPretty_setNeedSpace (p); - outText (p, (const char *) ")))", 3); - } - else - { - M2RTS_HALT (-1); /* metaError0 ('expecting two parameters to EXCL') */ - __builtin_unreachable (); - } - } -} - - -/* - doNewC - -*/ - -static void doNewC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (isIntrinsic (n)); - if (n->intrinsicF.args == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - if ((expListLen (n->intrinsicF.args)) == 1) - { - keyc_useStorage (); - outText (p, (const char *) "Storage_ALLOCATE", 16); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "((void **)", 10); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "&", 1); - doExprC (p, getExpList (n->intrinsicF.args, 1)); - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - t = decl_skipType (decl_getType (getExpList (n->intrinsicF.args, 1))); - if (decl_isPointer (t)) - { - t = decl_getType (t); - outText (p, (const char *) "sizeof", 6); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doTypeNameC (p, t); - mcPretty_noSpace (p); - outText (p, (const char *) "))", 2); - } - else - { - mcMetaError_metaError1 ((const char *) "expecting a pointer type variable as the argument to NEW, rather than {%1ad}", 76, (const unsigned char *) &t, (sizeof (t)-1)); - } - } - } -} - - -/* - doDisposeC - -*/ - -static void doDisposeC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (isIntrinsic (n)); - if (n->intrinsicF.args == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - if ((expListLen (n->intrinsicF.args)) == 1) - { - keyc_useStorage (); - outText (p, (const char *) "Storage_DEALLOCATE", 18); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "((void **)", 10); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "&", 1); - doExprC (p, getExpList (n->intrinsicF.args, 1)); - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - t = decl_skipType (decl_getType (getExpList (n->intrinsicF.args, 1))); - if (decl_isPointer (t)) - { - t = decl_getType (t); - outText (p, (const char *) "sizeof", 6); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doTypeNameC (p, t); - mcPretty_noSpace (p); - outText (p, (const char *) "))", 2); - } - else - { - mcMetaError_metaError1 ((const char *) "expecting a pointer type variable as the argument to DISPOSE, rather than {%1ad}", 80, (const unsigned char *) &t, (sizeof (t)-1)); - } - } - else - { - M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to DISPOSE') */ - __builtin_unreachable (); - } - } -} - - -/* - doCapC - -*/ - -static void doCapC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isUnary (n)); - if (n->unaryF.arg == NULL) - { - M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to CAP') */ - __builtin_unreachable (); - } - else - { - keyc_useCtype (); - if (mcOptions_getGccConfigSystem ()) - { - outText (p, (const char *) "TOUPPER", 7); - } - else - { - outText (p, (const char *) "toupper", 7); - } - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->unaryF.arg); - outText (p, (const char *) ")", 1); - } -} - - -/* - doLengthC - -*/ - -static void doLengthC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isUnary (n)); - if (n->unaryF.arg == NULL) - { - M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to LENGTH') */ - __builtin_unreachable (); - } - else - { - keyc_useM2RTS (); - outText (p, (const char *) "M2RTS_Length", 12); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->unaryF.arg); - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - doFuncHighC (p, n->unaryF.arg); - outText (p, (const char *) ")", 1); - } -} - - -/* - doAbsC - -*/ - -static void doAbsC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (isUnary (n)); - if (n->unaryF.arg == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - t = getExprType (n); - } - if (t == longintN) - { - keyc_useLabs (); - outText (p, (const char *) "labs", 4); - } - else if (t == integerN) - { - /* avoid dangling else. */ - keyc_useAbs (); - outText (p, (const char *) "abs", 3); - } - else if (t == realN) - { - /* avoid dangling else. */ - keyc_useFabs (); - outText (p, (const char *) "fabs", 4); - } - else if (t == longrealN) - { - /* avoid dangling else. */ - keyc_useFabsl (); - outText (p, (const char *) "fabsl", 5); - } - else if (t == cardinalN) - { - /* avoid dangling else. */ - } - else - { - /* avoid dangling else. */ - /* do nothing. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->unaryF.arg); - outText (p, (const char *) ")", 1); -} - - -/* - doValC - -*/ - -static void doValC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isBinary (n)); - outText (p, (const char *) "(", 1); - doTypeNameC (p, n->binaryF.left); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->binaryF.right); - outText (p, (const char *) ")", 1); -} - - -/* - doMinC - -*/ - -static void doMinC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (isUnary (n)); - t = getExprType (n->unaryF.arg); - doExprC (p, getMin (t)); -} - - -/* - doMaxC - -*/ - -static void doMaxC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (isUnary (n)); - t = getExprType (n->unaryF.arg); - doExprC (p, getMax (t)); -} - - -/* - isIntrinsic - returns if, n, is an intrinsic procedure. - The intrinsic functions are represented as unary and binary nodes. -*/ - -static unsigned int isIntrinsic (decl_node n) -{ - switch (n->kind) - { - case decl_unreachable: - case decl_throw: - case decl_inc: - case decl_dec: - case decl_incl: - case decl_excl: - case decl_new: - case decl_dispose: - case decl_halt: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doHalt - -*/ - -static void doHalt (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (n->kind == decl_halt); - if ((n->intrinsicF.args == NULL) || ((expListLen (n->intrinsicF.args)) == 0)) - { - outText (p, (const char *) "M2RTS_HALT", 10); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(-1)", 4); - } - else if ((expListLen (n->intrinsicF.args)) == 1) - { - /* avoid dangling else. */ - outText (p, (const char *) "M2RTS_HALT", 10); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, getExpList (n->intrinsicF.args, 1)); - outText (p, (const char *) ")", 1); - } -} - - -/* - doCreal - emit the appropriate creal function. -*/ - -static void doCreal (mcPretty_pretty p, decl_node t) -{ - switch (t->kind) - { - case decl_complex: - keyc_useComplex (); - outText (p, (const char *) "creal", 5); - break; - - case decl_longcomplex: - keyc_useComplex (); - outText (p, (const char *) "creall", 6); - break; - - case decl_shortcomplex: - keyc_useComplex (); - outText (p, (const char *) "crealf", 6); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - doCimag - emit the appropriate cimag function. -*/ - -static void doCimag (mcPretty_pretty p, decl_node t) -{ - switch (t->kind) - { - case decl_complex: - keyc_useComplex (); - outText (p, (const char *) "cimag", 5); - break; - - case decl_longcomplex: - keyc_useComplex (); - outText (p, (const char *) "cimagl", 6); - break; - - case decl_shortcomplex: - keyc_useComplex (); - outText (p, (const char *) "cimagf", 6); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - doReC - -*/ - -static void doReC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (n->kind == decl_re); - if (n->unaryF.arg != NULL) - { - t = getExprType (n->unaryF.arg); - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - doCreal (p, t); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->unaryF.arg); - outText (p, (const char *) ")", 1); -} - - -/* - doImC - -*/ - -static void doImC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (n->kind == decl_im); - if (n->unaryF.arg != NULL) - { - t = getExprType (n->unaryF.arg); - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - doCimag (p, t); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->unaryF.arg); - outText (p, (const char *) ")", 1); -} - - -/* - doCmplx - -*/ - -static void doCmplx (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isBinary (n)); - keyc_useComplex (); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->binaryF.left); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "+", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->binaryF.right); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "*", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "I", 1); - outText (p, (const char *) ")", 1); -} - - -/* - doIntrinsicC - -*/ - -static void doIntrinsicC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isIntrinsic (n)); - doCommentC (p, n->intrinsicF.intrinsicComment.body); - switch (n->kind) - { - case decl_unreachable: - doUnreachableC (p, n); - break; - - case decl_throw: - doThrowC (p, n); - break; - - case decl_halt: - doHalt (p, n); - break; - - case decl_inc: - doInc (p, n); - break; - - case decl_dec: - doDec (p, n); - break; - - case decl_incl: - doInclC (p, n); - break; - - case decl_excl: - doExclC (p, n); - break; - - case decl_new: - doNewC (p, n); - break; - - case decl_dispose: - doDisposeC (p, n); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - outText (p, (const char *) ";", 1); - doAfterCommentC (p, n->intrinsicF.intrinsicComment.after); -} - - -/* - isIntrinsicFunction - returns true if, n, is an instrinsic function. -*/ - -static unsigned int isIntrinsicFunction (decl_node n) -{ - switch (n->kind) - { - case decl_val: - case decl_adr: - case decl_size: - case decl_tsize: - case decl_float: - case decl_trunc: - case decl_ord: - case decl_chr: - case decl_cap: - case decl_abs: - case decl_high: - case decl_length: - case decl_min: - case decl_max: - case decl_re: - case decl_im: - case decl_cmplx: - return TRUE; - break; - - - default: - return FALSE; - break; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doSizeC - -*/ - -static void doSizeC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (isUnary (n)); - outText (p, (const char *) "sizeof (", 8); - doExprC (p, n->unaryF.arg); - outText (p, (const char *) ")", 1); -} - - -/* - doConvertC - -*/ - -static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high) -{ - char conversion[_conversion_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (conversion, conversion_, _conversion_high+1); - - mcDebug_assert (isUnary (n)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - outText (p, (const char *) conversion, _conversion_high); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->unaryF.arg); - outText (p, (const char *) "))", 2); -} - - -/* - getFuncFromExpr - -*/ - -static decl_node getFuncFromExpr (decl_node n) -{ - n = decl_skipType (decl_getType (n)); - while ((n != procN) && (! (decl_isProcType (n)))) - { - n = decl_skipType (decl_getType (n)); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doFuncExprC - -*/ - -static void doFuncExprC (mcPretty_pretty p, decl_node n) -{ - decl_node t; - - mcDebug_assert (isFuncCall (n)); - if (decl_isProcedure (n->funccallF.function)) - { - doFQDNameC (p, n->funccallF.function, TRUE); - mcPretty_setNeedSpace (p); - doFuncArgsC (p, n, n->funccallF.function->procedureF.parameters, TRUE); - } - else - { - outText (p, (const char *) "(*", 2); - doExprC (p, n->funccallF.function); - outText (p, (const char *) ".proc", 5); - outText (p, (const char *) ")", 1); - t = getFuncFromExpr (n->funccallF.function); - mcPretty_setNeedSpace (p); - if (t == procN) - { - doProcTypeArgsC (p, n, NULL, TRUE); - } - else - { - mcDebug_assert (decl_isProcType (t)); - doProcTypeArgsC (p, n, t->proctypeF.parameters, TRUE); - } - } -} - - -/* - doFuncCallC - -*/ - -static void doFuncCallC (mcPretty_pretty p, decl_node n) -{ - doCommentC (p, n->funccallF.funccallComment.body); - doFuncExprC (p, n); - outText (p, (const char *) ";", 1); - doAfterCommentC (p, n->funccallF.funccallComment.after); -} - - -/* - doCaseStatementC - -*/ - -static void doCaseStatementC (mcPretty_pretty p, decl_node n, unsigned int needBreak) -{ - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doStatementSequenceC (p, n); - if (needBreak) - { - outText (p, (const char *) "break;\\n", 8); - } - p = mcPretty_popPretty (p); -} - - -/* - doExceptionC - -*/ - -static void doExceptionC (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n) -{ - unsigned int w; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - w = decl_getDeclaredMod (n); - outText (p, (const char *) a, _a_high); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(\"", 2); - outTextS (p, mcLexBuf_findFileNameFromToken (w, 0)); - outText (p, (const char *) "\",", 2); - mcPretty_setNeedSpace (p); - outCard (p, mcLexBuf_tokenToLineNo (w, 0)); - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - outCard (p, mcLexBuf_tokenToColumnNo (w, 0)); - outText (p, (const char *) ");\\n", 4); - outText (p, (const char *) "__builtin_unreachable ();\\n", 27); -} - - -/* - doExceptionCP - -*/ - -static void doExceptionCP (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n) -{ - unsigned int w; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - w = decl_getDeclaredMod (n); - outText (p, (const char *) a, _a_high); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(\"", 2); - outTextS (p, mcLexBuf_findFileNameFromToken (w, 0)); - outText (p, (const char *) "\",", 2); - mcPretty_setNeedSpace (p); - outCard (p, mcLexBuf_tokenToLineNo (w, 0)); - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - outCard (p, mcLexBuf_tokenToColumnNo (w, 0)); - outText (p, (const char *) ");\\n", 4); - outText (p, (const char *) "__builtin_unreachable ();\\n", 27); -} - - -/* - doException - -*/ - -static void doException (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - keyc_useException (); - if (lang == decl_ansiCP) - { - doExceptionCP (p, (const char *) a, _a_high, n); - } - else - { - doExceptionC (p, (const char *) a, _a_high, n); - } -} - - -/* - doRangeListC - -*/ - -static void doRangeListC (mcPretty_pretty p, decl_node c) -{ - decl_node r; - unsigned int i; - unsigned int h; - - mcDebug_assert (decl_isCaseList (c)); - i = 1; - h = Indexing_HighIndice (c->caselistF.rangePairs); - while (i <= h) - { - r = static_cast (Indexing_GetIndice (c->caselistF.rangePairs, i)); - mcDebug_assert ((r->rangeF.hi == NULL) || (r->rangeF.lo == r->rangeF.hi)); - outText (p, (const char *) "case", 4); - mcPretty_setNeedSpace (p); - doExprC (p, r->rangeF.lo); - outText (p, (const char *) ":\\n", 3); - i += 1; - } -} - - -/* - doRangeIfListC - -*/ - -static void doRangeIfListC (mcPretty_pretty p, decl_node e, decl_node c) -{ - decl_node r; - unsigned int i; - unsigned int h; - - mcDebug_assert (decl_isCaseList (c)); - i = 1; - h = Indexing_HighIndice (c->caselistF.rangePairs); - while (i <= h) - { - r = static_cast (Indexing_GetIndice (c->caselistF.rangePairs, i)); - if ((r->rangeF.lo != r->rangeF.hi) && (r->rangeF.hi != NULL)) - { - outText (p, (const char *) "((", 2); - doExprC (p, e); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) ">=", 2); - mcPretty_setNeedSpace (p); - doExprC (p, r->rangeF.lo); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "&&", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "((", 2); - doExprC (p, e); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "<=", 2); - mcPretty_setNeedSpace (p); - doExprC (p, r->rangeF.hi); - outText (p, (const char *) ")", 1); - } - else - { - outText (p, (const char *) "((", 2); - doExprC (p, e); - outText (p, (const char *) ")", 1); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "==", 2); - mcPretty_setNeedSpace (p); - doExprC (p, r->rangeF.lo); - outText (p, (const char *) ")", 1); - } - if (i < h) - { - mcPretty_setNeedSpace (p); - outText (p, (const char *) "||", 2); - mcPretty_setNeedSpace (p); - } - i += 1; - } -} - - -/* - doCaseLabels - -*/ - -static void doCaseLabels (mcPretty_pretty p, decl_node n, unsigned int needBreak) -{ - mcDebug_assert (decl_isCaseLabelList (n)); - doRangeListC (p, n->caselabellistF.caseList); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doStatementSequenceC (p, n->caselabellistF.statements); - if (needBreak) - { - outText (p, (const char *) "break;\\n\\n", 10); - } - p = mcPretty_popPretty (p); -} - - -/* - doCaseLabelListC - -*/ - -static void doCaseLabelListC (mcPretty_pretty p, decl_node n, unsigned int haveElse) -{ - unsigned int i; - unsigned int h; - decl_node c; - - mcDebug_assert (decl_isCase (n)); - i = 1; - h = Indexing_HighIndice (n->caseF.caseLabelList); - while (i <= h) - { - c = static_cast (Indexing_GetIndice (n->caseF.caseLabelList, i)); - doCaseLabels (p, c, ((i < h) || haveElse) || caseException); - i += 1; - } -} - - -/* - doCaseIfLabels - -*/ - -static void doCaseIfLabels (mcPretty_pretty p, decl_node e, decl_node n, unsigned int i, unsigned int h) -{ - mcDebug_assert (decl_isCaseLabelList (n)); - if (i > 1) - { - outText (p, (const char *) "else", 4); - mcPretty_setNeedSpace (p); - } - outText (p, (const char *) "if", 2); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doRangeIfListC (p, e, n->caselabellistF.caseList); - outText (p, (const char *) ")\\n", 3); - if (h == 1) - { - doCompoundStmt (p, n->caselabellistF.statements); - } - else - { - outText (p, (const char *) "{\\n", 3); - doStatementSequenceC (p, n->caselabellistF.statements); - outText (p, (const char *) "}\\n", 3); - } -} - - -/* - doCaseIfLabelListC - -*/ - -static void doCaseIfLabelListC (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node c; - - mcDebug_assert (decl_isCase (n)); - i = 1; - h = Indexing_HighIndice (n->caseF.caseLabelList); - while (i <= h) - { - c = static_cast (Indexing_GetIndice (n->caseF.caseLabelList, i)); - doCaseIfLabels (p, n->caseF.expression, c, i, h); - i += 1; - } -} - - -/* - doCaseElseC - -*/ - -static void doCaseElseC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (decl_isCase (n)); - if (n->caseF.else_ == NULL) - { - /* avoid dangling else. */ - if (caseException) - { - outText (p, (const char *) "\\ndefault:\\n", 12); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doException (p, (const char *) "CaseException", 13, n); - p = mcPretty_popPretty (p); - } - } - else - { - outText (p, (const char *) "\\ndefault:\\n", 12); - doCaseStatementC (p, n->caseF.else_, TRUE); - } -} - - -/* - doCaseIfElseC - -*/ - -static void doCaseIfElseC (mcPretty_pretty p, decl_node n) -{ - mcDebug_assert (decl_isCase (n)); - if (n->caseF.else_ == NULL) - { - /* avoid dangling else. */ - if (TRUE) - { - outText (p, (const char *) "\\n", 2); - outText (p, (const char *) "else {\\n", 8); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doException (p, (const char *) "CaseException", 13, n); - p = mcPretty_popPretty (p); - outText (p, (const char *) "}\\n", 3); - } - } - else - { - outText (p, (const char *) "\\n", 2); - outText (p, (const char *) "else {\\n", 8); - doCaseStatementC (p, n->caseF.else_, FALSE); - outText (p, (const char *) "}\\n", 3); - } -} - - -/* - canUseSwitchCaseLabels - returns TRUE if all the case labels are - single values and not ranges. -*/ - -static unsigned int canUseSwitchCaseLabels (decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node r; - decl_node l; - - mcDebug_assert (decl_isCaseLabelList (n)); - l = n->caselabellistF.caseList; - i = 1; - h = Indexing_HighIndice (l->caselistF.rangePairs); - while (i <= h) - { - r = static_cast (Indexing_GetIndice (l->caselistF.rangePairs, i)); - if ((r->rangeF.hi != NULL) && (r->rangeF.lo != r->rangeF.hi)) - { - return FALSE; - } - i += 1; - } - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - canUseSwitch - returns TRUE if the case statement can be implement - by a switch statement. This will be TRUE if all case - selectors are single values rather than ranges. -*/ - -static unsigned int canUseSwitch (decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node c; - - mcDebug_assert (decl_isCase (n)); - i = 1; - h = Indexing_HighIndice (n->caseF.caseLabelList); - while (i <= h) - { - c = static_cast (Indexing_GetIndice (n->caseF.caseLabelList, i)); - if (! (canUseSwitchCaseLabels (c))) - { - return FALSE; - } - i += 1; - } - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doCaseC - -*/ - -static void doCaseC (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - - mcDebug_assert (decl_isCase (n)); - if (canUseSwitch (n)) - { - i = mcPretty_getindent (p); - outText (p, (const char *) "switch", 6); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - doExprC (p, n->caseF.expression); - p = mcPretty_pushPretty (p); - outText (p, (const char *) ")", 1); - mcPretty_setindent (p, i+indentationC); - outText (p, (const char *) "\\n{\\n", 5); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doCaseLabelListC (p, n, n->caseF.else_ != NULL); - doCaseElseC (p, n); - p = mcPretty_popPretty (p); - outText (p, (const char *) "}\\n", 3); - p = mcPretty_popPretty (p); - } - else - { - doCaseIfLabelListC (p, n); - doCaseIfElseC (p, n); - } -} - - -/* - doLoopC - -*/ - -static void doLoopC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (decl_isLoop (s)); - outText (p, (const char *) "for (;;)\\n", 10); - outText (p, (const char *) "{\\n", 3); - p = mcPretty_pushPretty (p); - mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC); - doStatementSequenceC (p, s->loopF.statements); - p = mcPretty_popPretty (p); - outText (p, (const char *) "}\\n", 3); -} - - -/* - doExitC - -*/ - -static void doExitC (mcPretty_pretty p, decl_node s) -{ - mcDebug_assert (decl_isExit (s)); - outText (p, (const char *) "/* exit. */\\n", 14); -} - - -/* - doStatementsC - -*/ - -static void doStatementsC (mcPretty_pretty p, decl_node s) -{ - if (s == NULL) - {} /* empty. */ - else if (decl_isStatementSequence (s)) - { - /* avoid dangling else. */ - doStatementSequenceC (p, s); - } - else if (isComment (s)) - { - /* avoid dangling else. */ - doCommentC (p, s); - } - else if (decl_isExit (s)) - { - /* avoid dangling else. */ - doExitC (p, s); - } - else if (decl_isReturn (s)) - { - /* avoid dangling else. */ - doReturnC (p, s); - } - else if (isAssignment (s)) - { - /* avoid dangling else. */ - doAssignmentC (p, s); - } - else if (decl_isIf (s)) - { - /* avoid dangling else. */ - doIfC (p, s); - } - else if (decl_isFor (s)) - { - /* avoid dangling else. */ - doForC (p, s); - } - else if (decl_isRepeat (s)) - { - /* avoid dangling else. */ - doRepeatC (p, s); - } - else if (decl_isWhile (s)) - { - /* avoid dangling else. */ - doWhileC (p, s); - } - else if (isIntrinsic (s)) - { - /* avoid dangling else. */ - doIntrinsicC (p, s); - } - else if (isFuncCall (s)) - { - /* avoid dangling else. */ - doFuncCallC (p, s); - } - else if (decl_isCase (s)) - { - /* avoid dangling else. */ - doCaseC (p, s); - } - else if (decl_isLoop (s)) - { - /* avoid dangling else. */ - doLoopC (p, s); - } - else if (decl_isExit (s)) - { - /* avoid dangling else. */ - doExitC (p, s); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); /* need to handle another s^.kind. */ - __builtin_unreachable (); - } -} - -static void stop (void) -{ -} - - -/* - doLocalVarC - -*/ - -static void doLocalVarC (mcPretty_pretty p, decl_scopeT s) -{ - includeVarProcedure (s); - debugLists (); - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}); -} - - -/* - doLocalConstTypesC - -*/ - -static void doLocalConstTypesC (mcPretty_pretty p, decl_scopeT s) -{ - simplifyTypes (s); - includeConstType (s); - doP = p; - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}); -} - - -/* - addParamDone - -*/ - -static void addParamDone (decl_node n) -{ - if ((decl_isVar (n)) && n->varF.isParameter) - { - addDone (n); - addDone (decl_getType (n)); - } -} - - -/* - includeParameters - -*/ - -static void includeParameters (decl_node n) -{ - mcDebug_assert (decl_isProcedure (n)); - Indexing_ForeachIndiceInIndexDo (n->procedureF.decls.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addParamDone}); -} - - -/* - isHalt - -*/ - -static unsigned int isHalt (decl_node n) -{ - return n->kind == decl_halt; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isReturnOrHalt - -*/ - -static unsigned int isReturnOrHalt (decl_node n) -{ - return (isHalt (n)) || (decl_isReturn (n)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLastStatementReturn - -*/ - -static unsigned int isLastStatementReturn (decl_node n) -{ - return isLastStatement (n, (decl_isNodeF) {(decl_isNodeF_t) isReturnOrHalt}); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLastStatementSequence - -*/ - -static unsigned int isLastStatementSequence (decl_node n, decl_isNodeF q) -{ - unsigned int h; - - mcDebug_assert (decl_isStatementSequence (n)); - h = Indexing_HighIndice (n->stmtF.statements); - if (h > 0) - { - return isLastStatement (reinterpret_cast (Indexing_GetIndice (n->stmtF.statements, h)), q); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLastStatementIf - -*/ - -static unsigned int isLastStatementIf (decl_node n, decl_isNodeF q) -{ - unsigned int ret; - - mcDebug_assert (decl_isIf (n)); - ret = TRUE; - if ((n->ifF.elsif != NULL) && ret) - { - ret = isLastStatement (n->ifF.elsif, q); - } - if ((n->ifF.then != NULL) && ret) - { - ret = isLastStatement (n->ifF.then, q); - } - if ((n->ifF.else_ != NULL) && ret) - { - ret = isLastStatement (n->ifF.else_, q); - } - return ret; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLastStatementElsif - -*/ - -static unsigned int isLastStatementElsif (decl_node n, decl_isNodeF q) -{ - unsigned int ret; - - mcDebug_assert (decl_isElsif (n)); - ret = TRUE; - if ((n->elsifF.elsif != NULL) && ret) - { - ret = isLastStatement (n->elsifF.elsif, q); - } - if ((n->elsifF.then != NULL) && ret) - { - ret = isLastStatement (n->elsifF.then, q); - } - if ((n->elsifF.else_ != NULL) && ret) - { - ret = isLastStatement (n->elsifF.else_, q); - } - return ret; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLastStatementCase - -*/ - -static unsigned int isLastStatementCase (decl_node n, decl_isNodeF q) -{ - unsigned int ret; - unsigned int i; - unsigned int h; - decl_node c; - - ret = TRUE; - mcDebug_assert (decl_isCase (n)); - i = 1; - h = Indexing_HighIndice (n->caseF.caseLabelList); - while (i <= h) - { - c = static_cast (Indexing_GetIndice (n->caseF.caseLabelList, i)); - mcDebug_assert (decl_isCaseLabelList (c)); - ret = ret && (isLastStatement (c->caselabellistF.statements, q)); - i += 1; - } - if (n->caseF.else_ != NULL) - { - ret = ret && (isLastStatement (n->caseF.else_, q)); - } - return ret; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLastStatement - returns TRUE if the last statement in, n, is, q. -*/ - -static unsigned int isLastStatement (decl_node n, decl_isNodeF q) -{ - unsigned int ret; - - if (n == NULL) - { - return FALSE; - } - else if (decl_isStatementSequence (n)) - { - /* avoid dangling else. */ - return isLastStatementSequence (n, q); - } - else if (decl_isProcedure (n)) - { - /* avoid dangling else. */ - mcDebug_assert (decl_isProcedure (n)); - return isLastStatement (n->procedureF.beginStatements, q); - } - else if (decl_isIf (n)) - { - /* avoid dangling else. */ - return isLastStatementIf (n, q); - } - else if (decl_isElsif (n)) - { - /* avoid dangling else. */ - return isLastStatementElsif (n, q); - } - else if (decl_isCase (n)) - { - /* avoid dangling else. */ - return isLastStatementCase (n, q); - } - else if ((*q.proc) (n)) - { - /* avoid dangling else. */ - return TRUE; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doProcedureC - -*/ - -static void doProcedureC (decl_node n) -{ - unsigned int s; - - outText (doP, (const char *) "\\n", 2); - includeParameters (n); - keyc_enterScope (n); - doProcedureHeadingC (n, FALSE); - outText (doP, (const char *) "\\n", 2); - doP = outKc (doP, (const char *) "{\\n", 3); - s = mcPretty_getcurline (doP); - doLocalConstTypesC (doP, n->procedureF.decls); - doLocalVarC (doP, n->procedureF.decls); - doUnboundedParamCopyC (doP, n); - if (s != (mcPretty_getcurline (doP))) - { - outText (doP, (const char *) "\\n", 2); - } - doStatementsC (doP, n->procedureF.beginStatements); - if (n->procedureF.returnType != NULL) - { - if (returnException) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (isLastStatementReturn (n)) - { - outText (doP, (const char *) "/* static analysis guarentees a RETURN statement will be used before here. */\\n", 80); - outText (doP, (const char *) "__builtin_unreachable ();\\n", 27); - } - else - { - doException (doP, (const char *) "ReturnException", 15, n); - } - } - } - doP = outKc (doP, (const char *) "}\\n", 3); - keyc_leaveScope (n); -} - - -/* - outProceduresC - -*/ - -static void outProceduresC (mcPretty_pretty p, decl_scopeT s) -{ - doP = p; - if (debugDecl) - { - libc_printf ((const char *) "seen %d procedures\\n", 20, Indexing_HighIndice (s.procedures)); - } - Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doProcedureC}); -} - - -/* - output - -*/ - -static void output (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v) -{ - if (decl_isConst (n)) - { - (*c.proc) (n); - } - else if (decl_isVar (n)) - { - /* avoid dangling else. */ - (*v.proc) (n); - } - else - { - /* avoid dangling else. */ - (*t.proc) (n); - } -} - - -/* - allDependants - -*/ - -static decl_dependentState allDependants (decl_node n) -{ - alists_alist l; - decl_dependentState s; - - l = alists_initList (); - s = walkDependants (l, n); - alists_killList (&l); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkDependants - -*/ - -static decl_dependentState walkDependants (alists_alist l, decl_node n) -{ - if ((n == NULL) || (alists_isItemInList (doneQ, reinterpret_cast (n)))) - { - return decl_completed; - } - else if (alists_isItemInList (l, reinterpret_cast (n))) - { - /* avoid dangling else. */ - return decl_recursive; - } - else - { - /* avoid dangling else. */ - alists_includeItemIntoList (l, reinterpret_cast (n)); - return doDependants (l, n); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkType - -*/ - -static decl_dependentState walkType (alists_alist l, decl_node n) -{ - decl_node t; - - t = decl_getType (n); - if (alists_isItemInList (doneQ, reinterpret_cast (t))) - { - return decl_completed; - } - else if (alists_isItemInList (partialQ, reinterpret_cast (t))) - { - /* avoid dangling else. */ - return decl_blocked; - } - else - { - /* avoid dangling else. */ - queueBlocked (t); - return decl_blocked; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - db - -*/ - -static void db (const char *a_, unsigned int _a_high, decl_node n) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - if (mcOptions_getDebugTopological ()) - { - outText (doP, (const char *) a, _a_high); - if (n != NULL) - { - outTextS (doP, gen (n)); - } - } -} - - -/* - dbt - -*/ - -static void dbt (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - if (mcOptions_getDebugTopological ()) - { - outText (doP, (const char *) a, _a_high); - } -} - - -/* - dbs - -*/ - -static void dbs (decl_dependentState s, decl_node n) -{ - if (mcOptions_getDebugTopological ()) - { - switch (s) - { - case decl_completed: - outText (doP, (const char *) "{completed ", 11); - break; - - case decl_blocked: - outText (doP, (const char *) "{blocked ", 9); - break; - - case decl_partial: - outText (doP, (const char *) "{partial ", 9); - break; - - case decl_recursive: - outText (doP, (const char *) "{recursive ", 11); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - if (n != NULL) - { - outTextS (doP, gen (n)); - } - outText (doP, (const char *) "}\\n", 3); - } -} - - -/* - dbq - -*/ - -static void dbq (decl_node n) -{ - if (mcOptions_getDebugTopological ()) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (alists_isItemInList (todoQ, reinterpret_cast (n))) - { - db ((const char *) "{T", 2, n); - outText (doP, (const char *) "}", 1); - } - else if (alists_isItemInList (partialQ, reinterpret_cast (n))) - { - /* avoid dangling else. */ - db ((const char *) "{P", 2, n); - outText (doP, (const char *) "}", 1); - } - else if (alists_isItemInList (doneQ, reinterpret_cast (n))) - { - /* avoid dangling else. */ - db ((const char *) "{D", 2, n); - outText (doP, (const char *) "}", 1); - } - } -} - - -/* - walkRecord - -*/ - -static decl_dependentState walkRecord (alists_alist l, decl_node n) -{ - decl_dependentState s; - unsigned int o; - unsigned int i; - unsigned int t; - decl_node q; - - i = Indexing_LowIndice (n->recordF.listOfSons); - t = Indexing_HighIndice (n->recordF.listOfSons); - db ((const char *) "\\nwalking ", 10, n); - o = mcPretty_getindent (doP); - mcPretty_setindent (doP, (mcPretty_getcurpos (doP))+3); - dbq (n); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); - db ((const char *) "", 0, q); - if ((decl_isRecordField (q)) && q->recordfieldF.tag) - {} /* empty. */ - else - { - /* do nothing as it is a tag selector processed in the varient. */ - s = walkDependants (l, q); - if (s != decl_completed) - { - dbs (s, q); - addTodo (n); - dbq (n); - db ((const char *) "\\n", 2, NULL); - mcPretty_setindent (doP, o); - return s; - } - } - i += 1; - } - db ((const char *) "{completed", 10, n); - dbt ((const char *) "}\\n", 3); - mcPretty_setindent (doP, o); - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkVarient - -*/ - -static decl_dependentState walkVarient (alists_alist l, decl_node n) -{ - decl_dependentState s; - unsigned int i; - unsigned int t; - decl_node q; - - db ((const char *) "\\nwalking", 9, n); - s = walkDependants (l, n->varientF.tag); - if (s != decl_completed) - { - dbs (s, n->varientF.tag); - dbq (n->varientF.tag); - db ((const char *) "\\n", 2, NULL); - return s; - } - i = Indexing_LowIndice (n->varientF.listOfSons); - t = Indexing_HighIndice (n->varientF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); - db ((const char *) "", 0, q); - s = walkDependants (l, q); - if (s != decl_completed) - { - dbs (s, q); - db ((const char *) "\\n", 2, NULL); - return s; - } - i += 1; - } - db ((const char *) "{completed", 10, n); - dbt ((const char *) "}\\n", 3); - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - queueBlocked - -*/ - -static void queueBlocked (decl_node n) -{ - if (! ((alists_isItemInList (doneQ, reinterpret_cast (n))) || (alists_isItemInList (partialQ, reinterpret_cast (n))))) - { - addTodo (n); - } -} - - -/* - walkVar - -*/ - -static decl_dependentState walkVar (alists_alist l, decl_node n) -{ - decl_node t; - - t = decl_getType (n); - if (alists_isItemInList (doneQ, reinterpret_cast (t))) - { - return decl_completed; - } - else - { - queueBlocked (t); - return decl_blocked; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkEnumeration - -*/ - -static decl_dependentState walkEnumeration (alists_alist l, decl_node n) -{ - decl_dependentState s; - unsigned int i; - unsigned int t; - decl_node q; - - i = Indexing_LowIndice (n->enumerationF.listOfSons); - t = Indexing_HighIndice (n->enumerationF.listOfSons); - s = decl_completed; - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); - s = walkDependants (l, q); - if (s != decl_completed) - { - return s; - } - i += 1; - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkSubrange - -*/ - -static decl_dependentState walkSubrange (alists_alist l, decl_node n) -{ - decl_dependentState s; - - s = walkDependants (l, n->subrangeF.low); - if (s != decl_completed) - { - return s; - } - s = walkDependants (l, n->subrangeF.high); - if (s != decl_completed) - { - return s; - } - s = walkDependants (l, n->subrangeF.type); - if (s != decl_completed) - { - return s; - } - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkSubscript - -*/ - -static decl_dependentState walkSubscript (alists_alist l, decl_node n) -{ - decl_dependentState s; - - s = walkDependants (l, n->subscriptF.expr); - if (s != decl_completed) - { - return s; - } - s = walkDependants (l, n->subscriptF.type); - if (s != decl_completed) - { - return s; - } - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkPointer - -*/ - -static decl_dependentState walkPointer (alists_alist l, decl_node n) -{ - decl_node t; - - /* if the type of, n, is done or partial then we can output pointer. */ - t = decl_getType (n); - if ((alists_isItemInList (partialQ, reinterpret_cast (t))) || (alists_isItemInList (doneQ, reinterpret_cast (t)))) - { - /* pointer to partial can always generate a complete type. */ - return decl_completed; - } - return walkType (l, n); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkArray - -*/ - -static decl_dependentState walkArray (alists_alist l, decl_node n) -{ - decl_dependentState s; - - /* an array can only be declared if its data type has already been emitted. */ - if (! (alists_isItemInList (doneQ, reinterpret_cast (n->arrayF.type)))) - { - s = walkDependants (l, n->arrayF.type); - queueBlocked (n->arrayF.type); - if (s == decl_completed) - { - /* downgrade the completed to partial as it has not yet been written. */ - return decl_partial; - } - else - { - return s; - } - } - return walkDependants (l, n->arrayF.subr); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkConst - -*/ - -static decl_dependentState walkConst (alists_alist l, decl_node n) -{ - decl_dependentState s; - - s = walkDependants (l, n->constF.type); - if (s != decl_completed) - { - return s; - } - s = walkDependants (l, n->constF.value); - if (s != decl_completed) - { - return s; - } - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkVarParam - -*/ - -static decl_dependentState walkVarParam (alists_alist l, decl_node n) -{ - decl_node t; - - t = decl_getType (n); - if (alists_isItemInList (partialQ, reinterpret_cast (t))) - { - /* parameter can be issued from a partial. */ - return decl_completed; - } - return walkDependants (l, t); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkParam - -*/ - -static decl_dependentState walkParam (alists_alist l, decl_node n) -{ - decl_node t; - - t = decl_getType (n); - if (alists_isItemInList (partialQ, reinterpret_cast (t))) - { - /* parameter can be issued from a partial. */ - return decl_completed; - } - return walkDependants (l, t); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkOptarg - -*/ - -static decl_dependentState walkOptarg (alists_alist l, decl_node n) -{ - decl_node t; - - t = decl_getType (n); - if (alists_isItemInList (partialQ, reinterpret_cast (t))) - { - /* parameter can be issued from a partial. */ - return decl_completed; - } - return walkDependants (l, t); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkRecordField - -*/ - -static decl_dependentState walkRecordField (alists_alist l, decl_node n) -{ - decl_node t; - decl_dependentState s; - - mcDebug_assert (decl_isRecordField (n)); - t = decl_getType (n); - if (alists_isItemInList (partialQ, reinterpret_cast (t))) - { - dbs (decl_partial, n); - return decl_partial; - } - else if (alists_isItemInList (doneQ, reinterpret_cast (t))) - { - /* avoid dangling else. */ - dbs (decl_completed, n); - return decl_completed; - } - else - { - /* avoid dangling else. */ - addTodo (t); - dbs (decl_blocked, n); - dbq (n); - dbq (t); - /* s := walkDependants (l, t) */ - return decl_blocked; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkVarientField - -*/ - -static decl_dependentState walkVarientField (alists_alist l, decl_node n) -{ - decl_dependentState s; - unsigned int i; - unsigned int t; - decl_node q; - - i = Indexing_LowIndice (n->varientfieldF.listOfSons); - t = Indexing_HighIndice (n->varientfieldF.listOfSons); - s = decl_completed; - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientfieldF.listOfSons, i)); - s = walkDependants (l, q); - if (s != decl_completed) - { - dbs (s, n); - return s; - } - i += 1; - } - n->varientfieldF.simple = t <= 1; - dbs (s, n); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkEnumerationField - -*/ - -static decl_dependentState walkEnumerationField (alists_alist l, decl_node n) -{ - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkSet - -*/ - -static decl_dependentState walkSet (alists_alist l, decl_node n) -{ - return walkDependants (l, decl_getType (n)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkProcType - -*/ - -static decl_dependentState walkProcType (alists_alist l, decl_node n) -{ - decl_dependentState s; - decl_node t; - - t = decl_getType (n); - if (alists_isItemInList (partialQ, reinterpret_cast (t))) - {} /* empty. */ - else - { - /* proctype can be generated from partial types. */ - s = walkDependants (l, t); - if (s != decl_completed) - { - return s; - } - } - return walkParameters (l, n->proctypeF.parameters); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkProcedure - -*/ - -static decl_dependentState walkProcedure (alists_alist l, decl_node n) -{ - decl_dependentState s; - - s = walkDependants (l, decl_getType (n)); - if (s != decl_completed) - { - return s; - } - return walkParameters (l, n->procedureF.parameters); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkParameters - -*/ - -static decl_dependentState walkParameters (alists_alist l, Indexing_Index p) -{ - decl_dependentState s; - unsigned int i; - unsigned int h; - decl_node q; - - i = Indexing_LowIndice (p); - h = Indexing_HighIndice (p); - while (i <= h) - { - q = static_cast (Indexing_GetIndice (p, i)); - s = walkDependants (l, q); - if (s != decl_completed) - { - return s; - } - i += 1; - } - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkFuncCall - -*/ - -static decl_dependentState walkFuncCall (alists_alist l, decl_node n) -{ - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkUnary - -*/ - -static decl_dependentState walkUnary (alists_alist l, decl_node n) -{ - decl_dependentState s; - - s = walkDependants (l, n->unaryF.arg); - if (s != decl_completed) - { - return s; - } - return walkDependants (l, n->unaryF.resultType); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkBinary - -*/ - -static decl_dependentState walkBinary (alists_alist l, decl_node n) -{ - decl_dependentState s; - - s = walkDependants (l, n->binaryF.left); - if (s != decl_completed) - { - return s; - } - s = walkDependants (l, n->binaryF.right); - if (s != decl_completed) - { - return s; - } - return walkDependants (l, n->binaryF.resultType); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkComponentRef - -*/ - -static decl_dependentState walkComponentRef (alists_alist l, decl_node n) -{ - decl_dependentState s; - - s = walkDependants (l, n->componentrefF.rec); - if (s != decl_completed) - { - return s; - } - s = walkDependants (l, n->componentrefF.field); - if (s != decl_completed) - { - return s; - } - return walkDependants (l, n->componentrefF.resultType); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkPointerRef - -*/ - -static decl_dependentState walkPointerRef (alists_alist l, decl_node n) -{ - decl_dependentState s; - - s = walkDependants (l, n->pointerrefF.ptr); - if (s != decl_completed) - { - return s; - } - s = walkDependants (l, n->pointerrefF.field); - if (s != decl_completed) - { - return s; - } - return walkDependants (l, n->pointerrefF.resultType); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - walkSetValue - -*/ - -static decl_dependentState walkSetValue (alists_alist l, decl_node n) -{ - decl_dependentState s; - unsigned int i; - unsigned int j; - - mcDebug_assert (decl_isSetValue (n)); - s = walkDependants (l, n->setvalueF.type); - if (s != decl_completed) - { - return s; - } - i = Indexing_LowIndice (n->setvalueF.values); - j = Indexing_HighIndice (n->setvalueF.values); - while (i <= j) - { - s = walkDependants (l, reinterpret_cast (Indexing_GetIndice (n->setvalueF.values, i))); - if (s != decl_completed) - { - return s; - } - i += 1; - } - return decl_completed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doDependants - return the dependentState depending upon whether - all dependants have been declared. -*/ - -static decl_dependentState doDependants (alists_alist l, decl_node n) -{ - switch (n->kind) - { - case decl_throw: - case decl_varargs: - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - case decl_boolean: - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_ztype: - case decl_rtype: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - case decl_proc: - /* base types. */ - return decl_completed; - break; - - case decl_type: - /* language features and compound type attributes. */ - return walkType (l, n); - break; - - case decl_record: - return walkRecord (l, n); - break; - - case decl_varient: - return walkVarient (l, n); - break; - - case decl_var: - return walkVar (l, n); - break; - - case decl_enumeration: - return walkEnumeration (l, n); - break; - - case decl_subrange: - return walkSubrange (l, n); - break; - - case decl_pointer: - return walkPointer (l, n); - break; - - case decl_array: - return walkArray (l, n); - break; - - case decl_string: - return decl_completed; - break; - - case decl_const: - return walkConst (l, n); - break; - - case decl_literal: - return decl_completed; - break; - - case decl_varparam: - return walkVarParam (l, n); - break; - - case decl_param: - return walkParam (l, n); - break; - - case decl_optarg: - return walkOptarg (l, n); - break; - - case decl_recordfield: - return walkRecordField (l, n); - break; - - case decl_varientfield: - return walkVarientField (l, n); - break; - - case decl_enumerationfield: - return walkEnumerationField (l, n); - break; - - case decl_set: - return walkSet (l, n); - break; - - case decl_proctype: - return walkProcType (l, n); - break; - - case decl_subscript: - return walkSubscript (l, n); - break; - - case decl_procedure: - /* blocks. */ - return walkProcedure (l, n); - break; - - case decl_def: - case decl_imp: - case decl_module: - case decl_loop: - case decl_while: - case decl_for: - case decl_repeat: - case decl_if: - case decl_elsif: - case decl_assignment: - /* statements. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - - case decl_componentref: - /* expressions. */ - return walkComponentRef (l, n); - break; - - case decl_pointerref: - return walkPointerRef (l, n); - break; - - case decl_not: - case decl_abs: - case decl_min: - case decl_max: - case decl_chr: - case decl_cap: - case decl_ord: - case decl_float: - case decl_trunc: - case decl_high: - return walkUnary (l, n); - break; - - case decl_cast: - case decl_val: - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - return walkBinary (l, n); - break; - - case decl_constexp: - case decl_neg: - case decl_adr: - case decl_size: - case decl_tsize: - case decl_deref: - return walkUnary (l, n); - break; - - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - return walkBinary (l, n); - break; - - case decl_funccall: - return walkFuncCall (l, n); - break; - - case decl_setvalue: - return walkSetValue (l, n); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - tryComplete - returns TRUE if node, n, can be and was completed. -*/ - -static unsigned int tryComplete (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v) -{ - if (decl_isEnumeration (n)) - { - /* can always emit enumerated types. */ - output (n, c, t, v); - return TRUE; - } - else if (((decl_isType (n)) && (decl_isTypeHidden (n))) && ((decl_getType (n)) == NULL)) - { - /* avoid dangling else. */ - /* can always emit hidden types. */ - outputHidden (n); - return TRUE; - } - else if ((allDependants (n)) == decl_completed) - { - /* avoid dangling else. */ - output (n, c, t, v); - return TRUE; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - tryCompleteFromPartial - -*/ - -static unsigned int tryCompleteFromPartial (decl_node n, decl_nodeProcedure t) -{ - if ((((decl_isType (n)) && ((decl_getType (n)) != NULL)) && (decl_isPointer (decl_getType (n)))) && ((allDependants (decl_getType (n))) == decl_completed)) - { - /* alists.includeItemIntoList (partialQ, getType (n)) ; */ - outputHiddenComplete (n); - return TRUE; - } - else if ((allDependants (n)) == decl_completed) - { - /* avoid dangling else. */ - (*t.proc) (n); - return TRUE; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - visitIntrinsicFunction - -*/ - -static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (isIntrinsicFunction (n)); - switch (n->kind) - { - case decl_val: - case decl_cmplx: - visitNode (v, n->binaryF.left, p); - visitNode (v, n->binaryF.right, p); - visitNode (v, n->binaryF.resultType, p); - break; - - case decl_length: - case decl_adr: - case decl_size: - case decl_tsize: - case decl_float: - case decl_trunc: - case decl_ord: - case decl_chr: - case decl_cap: - case decl_abs: - case decl_high: - case decl_min: - case decl_max: - case decl_re: - case decl_im: - visitNode (v, n->unaryF.arg, p); - visitNode (v, n->unaryF.resultType, p); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - visitUnary - -*/ - -static void visitUnary (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (isUnary (n)); - visitNode (v, n->unaryF.arg, p); - visitNode (v, n->unaryF.resultType, p); -} - - -/* - visitBinary - -*/ - -static void visitBinary (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - visitNode (v, n->binaryF.left, p); - visitNode (v, n->binaryF.right, p); - visitNode (v, n->binaryF.resultType, p); -} - - -/* - visitBoolean - -*/ - -static void visitBoolean (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - visitNode (v, falseN, p); - visitNode (v, trueN, p); -} - - -/* - visitScope - -*/ - -static void visitScope (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - if (mustVisitScope) - { - visitNode (v, n, p); - } -} - - -/* - visitType - -*/ - -static void visitType (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isType (n)); - visitNode (v, n->typeF.type, p); - visitScope (v, n->typeF.scope, p); -} - - -/* - visitIndex - -*/ - -static void visitIndex (alists_alist v, Indexing_Index i, decl_nodeProcedure p) -{ - unsigned int j; - unsigned int h; - - j = 1; - h = Indexing_HighIndice (i); - while (j <= h) - { - visitNode (v, reinterpret_cast (Indexing_GetIndice (i, j)), p); - j += 1; - } -} - - -/* - visitRecord - -*/ - -static void visitRecord (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isRecord (n)); - visitScope (v, n->recordF.scope, p); - visitIndex (v, n->recordF.listOfSons, p); -} - - -/* - visitVarient - -*/ - -static void visitVarient (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isVarient (n)); - visitIndex (v, n->varientF.listOfSons, p); - visitNode (v, n->varientF.varient, p); - visitNode (v, n->varientF.tag, p); - visitScope (v, n->varientF.scope, p); -} - - -/* - visitVar - -*/ - -static void visitVar (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isVar (n)); - visitNode (v, n->varF.type, p); - visitNode (v, n->varF.decl, p); - visitScope (v, n->varF.scope, p); -} - - -/* - visitEnumeration - -*/ - -static void visitEnumeration (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isEnumeration (n)); - visitIndex (v, n->enumerationF.listOfSons, p); - visitScope (v, n->enumerationF.scope, p); -} - - -/* - visitSubrange - -*/ - -static void visitSubrange (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isSubrange (n)); - visitNode (v, n->subrangeF.low, p); - visitNode (v, n->subrangeF.high, p); - visitNode (v, n->subrangeF.type, p); - visitScope (v, n->subrangeF.scope, p); -} - - -/* - visitPointer - -*/ - -static void visitPointer (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isPointer (n)); - visitNode (v, n->pointerF.type, p); - visitScope (v, n->pointerF.scope, p); -} - - -/* - visitArray - -*/ - -static void visitArray (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isArray (n)); - visitNode (v, n->arrayF.subr, p); - visitNode (v, n->arrayF.type, p); - visitScope (v, n->arrayF.scope, p); -} - - -/* - visitConst - -*/ - -static void visitConst (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isConst (n)); - visitNode (v, n->constF.type, p); - visitNode (v, n->constF.value, p); - visitScope (v, n->constF.scope, p); -} - - -/* - visitVarParam - -*/ - -static void visitVarParam (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isVarParam (n)); - visitNode (v, n->varparamF.namelist, p); - visitNode (v, n->varparamF.type, p); - visitScope (v, n->varparamF.scope, p); -} - - -/* - visitParam - -*/ - -static void visitParam (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isParam (n)); - visitNode (v, n->paramF.namelist, p); - visitNode (v, n->paramF.type, p); - visitScope (v, n->paramF.scope, p); -} - - -/* - visitOptarg - -*/ - -static void visitOptarg (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isOptarg (n)); - visitNode (v, n->optargF.namelist, p); - visitNode (v, n->optargF.type, p); - visitNode (v, n->optargF.init, p); - visitScope (v, n->optargF.scope, p); -} - - -/* - visitRecordField - -*/ - -static void visitRecordField (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isRecordField (n)); - visitNode (v, n->recordfieldF.type, p); - visitNode (v, n->recordfieldF.parent, p); - visitNode (v, n->recordfieldF.varient, p); - visitScope (v, n->recordfieldF.scope, p); -} - - -/* - visitVarientField - -*/ - -static void visitVarientField (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isVarientField (n)); - visitNode (v, n->varientfieldF.parent, p); - visitNode (v, n->varientfieldF.varient, p); - visitIndex (v, n->varientfieldF.listOfSons, p); - visitScope (v, n->varientfieldF.scope, p); -} - - -/* - visitEnumerationField - -*/ - -static void visitEnumerationField (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isEnumerationField (n)); - visitNode (v, n->enumerationfieldF.type, p); - visitScope (v, n->enumerationfieldF.scope, p); -} - - -/* - visitSet - -*/ - -static void visitSet (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isSet (n)); - visitNode (v, n->setF.type, p); - visitScope (v, n->setF.scope, p); -} - - -/* - visitProcType - -*/ - -static void visitProcType (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isProcType (n)); - visitIndex (v, n->proctypeF.parameters, p); - visitNode (v, n->proctypeF.optarg_, p); - visitNode (v, n->proctypeF.returnType, p); - visitScope (v, n->proctypeF.scope, p); -} - - -/* - visitSubscript - -*/ - -static void visitSubscript (alists_alist v, decl_node n, decl_nodeProcedure p) -{ -} - - -/* - visitDecls - -*/ - -static void visitDecls (alists_alist v, decl_scopeT s, decl_nodeProcedure p) -{ - visitIndex (v, s.constants, p); - visitIndex (v, s.types, p); - visitIndex (v, s.procedures, p); - visitIndex (v, s.variables, p); -} - - -/* - visitProcedure - -*/ - -static void visitProcedure (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isProcedure (n)); - visitDecls (v, n->procedureF.decls, p); - visitScope (v, n->procedureF.scope, p); - visitIndex (v, n->procedureF.parameters, p); - visitNode (v, n->procedureF.optarg_, p); - visitNode (v, n->procedureF.returnType, p); - visitNode (v, n->procedureF.beginStatements, p); -} - - -/* - visitDef - -*/ - -static void visitDef (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isDef (n)); - visitDecls (v, n->defF.decls, p); -} - - -/* - visitImp - -*/ - -static void visitImp (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isImp (n)); - visitDecls (v, n->impF.decls, p); - visitNode (v, n->impF.beginStatements, p); - /* --fixme-- do we need to visit definitionModule? */ - visitNode (v, n->impF.finallyStatements, p); -} - - -/* - visitModule - -*/ - -static void visitModule (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isModule (n)); - visitDecls (v, n->moduleF.decls, p); - visitNode (v, n->moduleF.beginStatements, p); - visitNode (v, n->moduleF.finallyStatements, p); -} - - -/* - visitLoop - -*/ - -static void visitLoop (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isLoop (n)); - visitNode (v, n->loopF.statements, p); -} - - -/* - visitWhile - -*/ - -static void visitWhile (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isWhile (n)); - visitNode (v, n->whileF.expr, p); - visitNode (v, n->whileF.statements, p); -} - - -/* - visitRepeat - -*/ - -static void visitRepeat (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isRepeat (n)); - visitNode (v, n->repeatF.expr, p); - visitNode (v, n->repeatF.statements, p); -} - - -/* - visitCase - -*/ - -static void visitCase (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isCase (n)); - visitNode (v, n->caseF.expression, p); - visitIndex (v, n->caseF.caseLabelList, p); - visitNode (v, n->caseF.else_, p); -} - - -/* - visitCaseLabelList - -*/ - -static void visitCaseLabelList (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isCaseLabelList (n)); - visitNode (v, n->caselabellistF.caseList, p); - visitNode (v, n->caselabellistF.statements, p); -} - - -/* - visitCaseList - -*/ - -static void visitCaseList (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isCaseList (n)); - visitIndex (v, n->caselistF.rangePairs, p); -} - - -/* - visitRange - -*/ - -static void visitRange (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isRange (n)); - visitNode (v, n->rangeF.lo, p); - visitNode (v, n->rangeF.hi, p); -} - - -/* - visitIf - -*/ - -static void visitIf (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isIf (n)); - visitNode (v, n->ifF.expr, p); - visitNode (v, n->ifF.elsif, p); - visitNode (v, n->ifF.then, p); - visitNode (v, n->ifF.else_, p); -} - - -/* - visitElsif - -*/ - -static void visitElsif (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isElsif (n)); - visitNode (v, n->elsifF.expr, p); - visitNode (v, n->elsifF.elsif, p); - visitNode (v, n->elsifF.then, p); - visitNode (v, n->elsifF.else_, p); -} - - -/* - visitFor - -*/ - -static void visitFor (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isFor (n)); - visitNode (v, n->forF.des, p); - visitNode (v, n->forF.start, p); - visitNode (v, n->forF.end, p); - visitNode (v, n->forF.increment, p); - visitNode (v, n->forF.statements, p); -} - - -/* - visitAssignment - -*/ - -static void visitAssignment (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (isAssignment (n)); - visitNode (v, n->assignmentF.des, p); - visitNode (v, n->assignmentF.expr, p); -} - - -/* - visitComponentRef - -*/ - -static void visitComponentRef (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (isComponentRef (n)); - visitNode (v, n->componentrefF.rec, p); - visitNode (v, n->componentrefF.field, p); - visitNode (v, n->componentrefF.resultType, p); -} - - -/* - visitPointerRef - -*/ - -static void visitPointerRef (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isPointerRef (n)); - visitNode (v, n->pointerrefF.ptr, p); - visitNode (v, n->pointerrefF.field, p); - visitNode (v, n->pointerrefF.resultType, p); -} - - -/* - visitArrayRef - -*/ - -static void visitArrayRef (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (isArrayRef (n)); - visitNode (v, n->arrayrefF.array, p); - visitNode (v, n->arrayrefF.index, p); - visitNode (v, n->arrayrefF.resultType, p); -} - - -/* - visitFunccall - -*/ - -static void visitFunccall (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (isFuncCall (n)); - visitNode (v, n->funccallF.function, p); - visitNode (v, n->funccallF.args, p); - visitNode (v, n->funccallF.type, p); -} - - -/* - visitVarDecl - -*/ - -static void visitVarDecl (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (isVarDecl (n)); - visitNode (v, n->vardeclF.type, p); - visitScope (v, n->vardeclF.scope, p); -} - - -/* - visitExplist - -*/ - -static void visitExplist (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isExpList (n)); - visitIndex (v, n->explistF.exp, p); -} - - -/* - visitExit - -*/ - -static void visitExit (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isExit (n)); - visitNode (v, n->exitF.loop, p); -} - - -/* - visitReturn - -*/ - -static void visitReturn (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isReturn (n)); - visitNode (v, n->returnF.exp, p); -} - - -/* - visitStmtSeq - -*/ - -static void visitStmtSeq (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isStatementSequence (n)); - visitIndex (v, n->stmtF.statements, p); -} - - -/* - visitVarargs - -*/ - -static void visitVarargs (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isVarargs (n)); - visitScope (v, n->varargsF.scope, p); -} - - -/* - visitSetValue - -*/ - -static void visitSetValue (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (decl_isSetValue (n)); - visitNode (v, n->setvalueF.type, p); - visitIndex (v, n->setvalueF.values, p); -} - - -/* - visitIntrinsic - -*/ - -static void visitIntrinsic (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (isIntrinsic (n)); - visitNode (v, n->intrinsicF.args, p); -} - - -/* - visitDependants - helper procedure function called from visitNode. - node n has just been visited, this procedure will - visit node, n, dependants. -*/ - -static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - mcDebug_assert (n != NULL); - mcDebug_assert (alists_isItemInList (v, reinterpret_cast (n))); - switch (n->kind) - { - case decl_explist: - visitExplist (v, n, p); - break; - - case decl_funccall: - visitFunccall (v, n, p); - break; - - case decl_exit: - visitExit (v, n, p); - break; - - case decl_return: - visitReturn (v, n, p); - break; - - case decl_stmtseq: - visitStmtSeq (v, n, p); - break; - - case decl_comment: - break; - - case decl_length: - visitIntrinsicFunction (v, n, p); - break; - - case decl_unreachable: - case decl_throw: - case decl_halt: - case decl_new: - case decl_dispose: - case decl_inc: - case decl_dec: - case decl_incl: - case decl_excl: - visitIntrinsic (v, n, p); - break; - - case decl_boolean: - visitBoolean (v, n, p); - break; - - case decl_nil: - case decl_false: - case decl_true: - break; - - case decl_varargs: - visitVarargs (v, n, p); - break; - - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_ztype: - case decl_rtype: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - case decl_proc: - break; - - case decl_type: - /* language features and compound type attributes. */ - visitType (v, n, p); - break; - - case decl_record: - visitRecord (v, n, p); - break; - - case decl_varient: - visitVarient (v, n, p); - break; - - case decl_var: - visitVar (v, n, p); - break; - - case decl_enumeration: - visitEnumeration (v, n, p); - break; - - case decl_subrange: - visitSubrange (v, n, p); - break; - - case decl_pointer: - visitPointer (v, n, p); - break; - - case decl_array: - visitArray (v, n, p); - break; - - case decl_string: - break; - - case decl_const: - visitConst (v, n, p); - break; - - case decl_literal: - break; - - case decl_varparam: - visitVarParam (v, n, p); - break; - - case decl_param: - visitParam (v, n, p); - break; - - case decl_optarg: - visitOptarg (v, n, p); - break; - - case decl_recordfield: - visitRecordField (v, n, p); - break; - - case decl_varientfield: - visitVarientField (v, n, p); - break; - - case decl_enumerationfield: - visitEnumerationField (v, n, p); - break; - - case decl_set: - visitSet (v, n, p); - break; - - case decl_proctype: - visitProcType (v, n, p); - break; - - case decl_subscript: - visitSubscript (v, n, p); - break; - - case decl_procedure: - /* blocks. */ - visitProcedure (v, n, p); - break; - - case decl_def: - visitDef (v, n, p); - break; - - case decl_imp: - visitImp (v, n, p); - break; - - case decl_module: - visitModule (v, n, p); - break; - - case decl_loop: - /* statements. */ - visitLoop (v, n, p); - break; - - case decl_while: - visitWhile (v, n, p); - break; - - case decl_for: - visitFor (v, n, p); - break; - - case decl_repeat: - visitRepeat (v, n, p); - break; - - case decl_case: - visitCase (v, n, p); - break; - - case decl_caselabellist: - visitCaseLabelList (v, n, p); - break; - - case decl_caselist: - visitCaseList (v, n, p); - break; - - case decl_range: - visitRange (v, n, p); - break; - - case decl_if: - visitIf (v, n, p); - break; - - case decl_elsif: - visitElsif (v, n, p); - break; - - case decl_assignment: - visitAssignment (v, n, p); - break; - - case decl_componentref: - /* expressions. */ - visitComponentRef (v, n, p); - break; - - case decl_pointerref: - visitPointerRef (v, n, p); - break; - - case decl_arrayref: - visitArrayRef (v, n, p); - break; - - case decl_cmplx: - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - case decl_and: - case decl_or: - case decl_in: - case decl_cast: - case decl_val: - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - visitBinary (v, n, p); - break; - - case decl_re: - visitUnary (v, n, p); - break; - - case decl_im: - visitUnary (v, n, p); - break; - - case decl_abs: - visitUnary (v, n, p); - break; - - case decl_chr: - visitUnary (v, n, p); - break; - - case decl_cap: - visitUnary (v, n, p); - break; - - case decl_high: - visitUnary (v, n, p); - break; - - case decl_ord: - visitUnary (v, n, p); - break; - - case decl_float: - visitUnary (v, n, p); - break; - - case decl_trunc: - visitUnary (v, n, p); - break; - - case decl_not: - visitUnary (v, n, p); - break; - - case decl_neg: - visitUnary (v, n, p); - break; - - case decl_adr: - visitUnary (v, n, p); - break; - - case decl_size: - visitUnary (v, n, p); - break; - - case decl_tsize: - visitUnary (v, n, p); - break; - - case decl_min: - visitUnary (v, n, p); - break; - - case decl_max: - visitUnary (v, n, p); - break; - - case decl_constexp: - visitUnary (v, n, p); - break; - - case decl_deref: - visitUnary (v, n, p); - break; - - case decl_identlist: - break; - - case decl_vardecl: - visitVarDecl (v, n, p); - break; - - case decl_setvalue: - visitSetValue (v, n, p); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - visitNode - visits node, n, if it is not already in the alist, v. - It calls p(n) if the node is unvisited. -*/ - -static void visitNode (alists_alist v, decl_node n, decl_nodeProcedure p) -{ - if ((n != NULL) && (! (alists_isItemInList (v, reinterpret_cast (n))))) - { - alists_includeItemIntoList (v, reinterpret_cast (n)); - (*p.proc) (n); - visitDependants (v, n, p); - } -} - - -/* - genKind - returns a string depending upon the kind of node, n. -*/ - -static DynamicStrings_String genKind (decl_node n) -{ - switch (n->kind) - { - case decl_nil: - case decl_true: - case decl_false: - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_boolean: - case decl_proc: - case decl_ztype: - case decl_rtype: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - /* types, no need to generate a kind string as it it contained in the name. */ - return NULL; - break; - - case decl_type: - /* language features and compound type attributes. */ - return DynamicStrings_InitString ((const char *) "type", 4); - break; - - case decl_record: - return DynamicStrings_InitString ((const char *) "record", 6); - break; - - case decl_varient: - return DynamicStrings_InitString ((const char *) "varient", 7); - break; - - case decl_var: - return DynamicStrings_InitString ((const char *) "var", 3); - break; - - case decl_enumeration: - return DynamicStrings_InitString ((const char *) "enumeration", 11); - break; - - case decl_subrange: - return DynamicStrings_InitString ((const char *) "subrange", 8); - break; - - case decl_array: - return DynamicStrings_InitString ((const char *) "array", 5); - break; - - case decl_subscript: - return DynamicStrings_InitString ((const char *) "subscript", 9); - break; - - case decl_string: - return DynamicStrings_InitString ((const char *) "string", 6); - break; - - case decl_const: - return DynamicStrings_InitString ((const char *) "const", 5); - break; - - case decl_literal: - return DynamicStrings_InitString ((const char *) "literal", 7); - break; - - case decl_varparam: - return DynamicStrings_InitString ((const char *) "varparam", 8); - break; - - case decl_param: - return DynamicStrings_InitString ((const char *) "param", 5); - break; - - case decl_varargs: - return DynamicStrings_InitString ((const char *) "varargs", 7); - break; - - case decl_pointer: - return DynamicStrings_InitString ((const char *) "pointer", 7); - break; - - case decl_recordfield: - return DynamicStrings_InitString ((const char *) "recordfield", 11); - break; - - case decl_varientfield: - return DynamicStrings_InitString ((const char *) "varientfield", 12); - break; - - case decl_enumerationfield: - return DynamicStrings_InitString ((const char *) "enumerationfield", 16); - break; - - case decl_set: - return DynamicStrings_InitString ((const char *) "set", 3); - break; - - case decl_proctype: - return DynamicStrings_InitString ((const char *) "proctype", 8); - break; - - case decl_procedure: - /* blocks. */ - return DynamicStrings_InitString ((const char *) "procedure", 9); - break; - - case decl_def: - return DynamicStrings_InitString ((const char *) "def", 3); - break; - - case decl_imp: - return DynamicStrings_InitString ((const char *) "imp", 3); - break; - - case decl_module: - return DynamicStrings_InitString ((const char *) "module", 6); - break; - - case decl_loop: - /* statements. */ - return DynamicStrings_InitString ((const char *) "loop", 4); - break; - - case decl_while: - return DynamicStrings_InitString ((const char *) "while", 5); - break; - - case decl_for: - return DynamicStrings_InitString ((const char *) "for", 3); - break; - - case decl_repeat: - return DynamicStrings_InitString ((const char *) "repeat", 6); - break; - - case decl_assignment: - return DynamicStrings_InitString ((const char *) "assignment", 10); - break; - - case decl_if: - return DynamicStrings_InitString ((const char *) "if", 2); - break; - - case decl_elsif: - return DynamicStrings_InitString ((const char *) "elsif", 5); - break; - - case decl_constexp: - /* expressions. */ - return DynamicStrings_InitString ((const char *) "constexp", 8); - break; - - case decl_neg: - return DynamicStrings_InitString ((const char *) "neg", 3); - break; - - case decl_cast: - return DynamicStrings_InitString ((const char *) "cast", 4); - break; - - case decl_val: - return DynamicStrings_InitString ((const char *) "val", 3); - break; - - case decl_plus: - return DynamicStrings_InitString ((const char *) "plus", 4); - break; - - case decl_sub: - return DynamicStrings_InitString ((const char *) "sub", 3); - break; - - case decl_div: - return DynamicStrings_InitString ((const char *) "div", 3); - break; - - case decl_mod: - return DynamicStrings_InitString ((const char *) "mod", 3); - break; - - case decl_mult: - return DynamicStrings_InitString ((const char *) "mult", 4); - break; - - case decl_divide: - return DynamicStrings_InitString ((const char *) "divide", 6); - break; - - case decl_adr: - return DynamicStrings_InitString ((const char *) "adr", 3); - break; - - case decl_size: - return DynamicStrings_InitString ((const char *) "size", 4); - break; - - case decl_tsize: - return DynamicStrings_InitString ((const char *) "tsize", 5); - break; - - case decl_chr: - return DynamicStrings_InitString ((const char *) "chr", 3); - break; - - case decl_ord: - return DynamicStrings_InitString ((const char *) "ord", 3); - break; - - case decl_float: - return DynamicStrings_InitString ((const char *) "float", 5); - break; - - case decl_trunc: - return DynamicStrings_InitString ((const char *) "trunc", 5); - break; - - case decl_high: - return DynamicStrings_InitString ((const char *) "high", 4); - break; - - case decl_componentref: - return DynamicStrings_InitString ((const char *) "componentref", 12); - break; - - case decl_pointerref: - return DynamicStrings_InitString ((const char *) "pointerref", 10); - break; - - case decl_arrayref: - return DynamicStrings_InitString ((const char *) "arrayref", 8); - break; - - case decl_deref: - return DynamicStrings_InitString ((const char *) "deref", 5); - break; - - case decl_equal: - return DynamicStrings_InitString ((const char *) "equal", 5); - break; - - case decl_notequal: - return DynamicStrings_InitString ((const char *) "notequal", 8); - break; - - case decl_less: - return DynamicStrings_InitString ((const char *) "less", 4); - break; - - case decl_greater: - return DynamicStrings_InitString ((const char *) "greater", 7); - break; - - case decl_greequal: - return DynamicStrings_InitString ((const char *) "greequal", 8); - break; - - case decl_lessequal: - return DynamicStrings_InitString ((const char *) "lessequal", 9); - break; - - case decl_lsl: - return DynamicStrings_InitString ((const char *) "lsl", 3); - break; - - case decl_lsr: - return DynamicStrings_InitString ((const char *) "lsr", 3); - break; - - case decl_lor: - return DynamicStrings_InitString ((const char *) "lor", 3); - break; - - case decl_land: - return DynamicStrings_InitString ((const char *) "land", 4); - break; - - case decl_lnot: - return DynamicStrings_InitString ((const char *) "lnot", 4); - break; - - case decl_lxor: - return DynamicStrings_InitString ((const char *) "lxor", 4); - break; - - case decl_and: - return DynamicStrings_InitString ((const char *) "and", 3); - break; - - case decl_or: - return DynamicStrings_InitString ((const char *) "or", 2); - break; - - case decl_not: - return DynamicStrings_InitString ((const char *) "not", 3); - break; - - case decl_identlist: - return DynamicStrings_InitString ((const char *) "identlist", 9); - break; - - case decl_vardecl: - return DynamicStrings_InitString ((const char *) "vardecl", 7); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - M2RTS_HALT (-1); - __builtin_unreachable (); - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - gen - generate a small string describing node, n. -*/ - -static DynamicStrings_String gen (decl_node n) -{ - DynamicStrings_String s; - unsigned int d; - - d = (unsigned int ) ((long unsigned int ) (n)); - s = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "< %d ", 5), (const unsigned char *) &d, (sizeof (d)-1)); /* use 0x%x once FormatStrings has been released. */ - s = DynamicStrings_ConCat (s, genKind (n)); /* use 0x%x once FormatStrings has been released. */ - s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) " ", 1)); - s = DynamicStrings_ConCat (s, getFQstring (n)); - s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) " >", 2)); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dumpQ - -*/ - -static void dumpQ (const char *q_, unsigned int _q_high, alists_alist l) -{ - DynamicStrings_String m; - decl_node n; - unsigned int d; - unsigned int h; - unsigned int i; - char q[_q_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (q, q_, _q_high+1); - - m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "Queue ", 6)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); - m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) q, _q_high)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); - m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); - i = 1; - h = alists_noOfItemsInList (l); - while (i <= h) - { - n = static_cast (alists_getItemFromList (l, i)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, gen (n))); - i += 1; - } - m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); -} - - -/* - dumpLists - -*/ - -static void dumpLists (void) -{ - DynamicStrings_String m; - - if (mcOptions_getDebugTopological ()) - { - m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2)); - m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m)); - dumpQ ((const char *) "todo", 4, todoQ); - dumpQ ((const char *) "partial", 7, partialQ); - dumpQ ((const char *) "done", 4, doneQ); - } -} - - -/* - outputHidden - -*/ - -static void outputHidden (decl_node n) -{ - outText (doP, (const char *) "#if !defined (", 14); - doFQNameC (doP, n); - outText (doP, (const char *) "_D)\\n", 5); - outText (doP, (const char *) "# define ", 10); - doFQNameC (doP, n); - outText (doP, (const char *) "_D\\n", 4); - outText (doP, (const char *) " typedef void *", 17); - doFQNameC (doP, n); - outText (doP, (const char *) ";\\n", 3); - outText (doP, (const char *) "#endif\\n\\n", 10); -} - - -/* - outputHiddenComplete - -*/ - -static void outputHiddenComplete (decl_node n) -{ - decl_node t; - - mcDebug_assert (decl_isType (n)); - t = decl_getType (n); - mcDebug_assert (decl_isPointer (t)); - outText (doP, (const char *) "#define ", 8); - doFQNameC (doP, n); - outText (doP, (const char *) "_D\\n", 4); - outText (doP, (const char *) "typedef ", 8); - doTypeNameC (doP, decl_getType (t)); - mcPretty_setNeedSpace (doP); - outText (doP, (const char *) "*", 1); - doFQNameC (doP, n); - outText (doP, (const char *) ";\\n", 3); -} - - -/* - tryPartial - -*/ - -static unsigned int tryPartial (decl_node n, decl_nodeProcedure pt) -{ - decl_node q; - - if ((n != NULL) && (decl_isType (n))) - { - q = decl_getType (n); - while (decl_isPointer (q)) - { - q = decl_getType (q); - } - if (q != NULL) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((decl_isRecord (q)) || (decl_isProcType (q))) - { - (*pt.proc) (n); - addTodo (q); - return TRUE; - } - else if (decl_isArray (q)) - { - /* avoid dangling else. */ - (*pt.proc) (n); - addTodo (q); - return TRUE; - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - outputPartialRecordArrayProcType - -*/ - -static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection) -{ - DynamicStrings_String s; - - outText (doP, (const char *) "typedef struct", 14); - mcPretty_setNeedSpace (doP); - s = getFQstring (n); - if (decl_isRecord (q)) - { - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_r", 2))); - } - else if (decl_isArray (q)) - { - /* avoid dangling else. */ - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_a", 2))); - } - else if (decl_isProcType (q)) - { - /* avoid dangling else. */ - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_p", 2))); - } - outTextS (doP, s); - mcPretty_setNeedSpace (doP); - s = DynamicStrings_KillString (s); - while (indirection > 0) - { - outText (doP, (const char *) "*", 1); - indirection -= 1; - } - doFQNameC (doP, n); - outText (doP, (const char *) ";\\n\\n", 5); -} - - -/* - outputPartial - -*/ - -static void outputPartial (decl_node n) -{ - decl_node q; - unsigned int indirection; - - q = decl_getType (n); - indirection = 0; - while (decl_isPointer (q)) - { - q = decl_getType (q); - indirection += 1; - } - outputPartialRecordArrayProcType (n, q, indirection); -} - - -/* - tryOutputTodo - -*/ - -static void tryOutputTodo (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure pt) -{ - unsigned int i; - unsigned int n; - decl_node d; - - i = 1; - n = alists_noOfItemsInList (todoQ); - while (i <= n) - { - d = static_cast (alists_getItemFromList (todoQ, i)); - if (tryComplete (d, c, t, v)) - { - alists_removeItemFromList (todoQ, reinterpret_cast (d)); - alists_includeItemIntoList (doneQ, reinterpret_cast (d)); - i = 1; - } - else if (tryPartial (d, pt)) - { - /* avoid dangling else. */ - alists_removeItemFromList (todoQ, reinterpret_cast (d)); - alists_includeItemIntoList (partialQ, reinterpret_cast (d)); - i = 1; - } - else - { - /* avoid dangling else. */ - i += 1; - } - n = alists_noOfItemsInList (todoQ); - } -} - - -/* - tryOutputPartial - -*/ - -static void tryOutputPartial (decl_nodeProcedure t) -{ - unsigned int i; - unsigned int n; - decl_node d; - - i = 1; - n = alists_noOfItemsInList (partialQ); - while (i <= n) - { - d = static_cast (alists_getItemFromList (partialQ, i)); - if (tryCompleteFromPartial (d, t)) - { - alists_removeItemFromList (partialQ, reinterpret_cast (d)); - alists_includeItemIntoList (doneQ, reinterpret_cast (d)); - i = 1; - n -= 1; - } - else - { - i += 1; - } - } -} - - -/* - debugList - -*/ - -static void debugList (const char *a_, unsigned int _a_high, alists_alist l) -{ - unsigned int i; - unsigned int h; - decl_node n; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - h = alists_noOfItemsInList (l); - if (h > 0) - { - outText (doP, (const char *) a, _a_high); - outText (doP, (const char *) " still contains node(s)\\n", 25); - i = 1; - do { - n = static_cast (alists_getItemFromList (l, i)); - dbg (n); - i += 1; - } while (! (i > h)); - } -} - - -/* - debugLists - -*/ - -static void debugLists (void) -{ - if (mcOptions_getDebugTopological ()) - { - debugList ((const char *) "todo", 4, todoQ); - debugList ((const char *) "partial", 7, partialQ); - } -} - - -/* - addEnumConst - -*/ - -static void addEnumConst (decl_node n) -{ - DynamicStrings_String s; - - if ((decl_isConst (n)) || (decl_isEnumeration (n))) - { - addTodo (n); - } -} - - -/* - populateTodo - -*/ - -static void populateTodo (decl_nodeProcedure p) -{ - decl_node n; - unsigned int i; - unsigned int h; - alists_alist l; - - h = alists_noOfItemsInList (todoQ); - i = 1; - while (i <= h) - { - n = static_cast (alists_getItemFromList (todoQ, i)); - l = alists_initList (); - visitNode (l, n, p); - alists_killList (&l); - h = alists_noOfItemsInList (todoQ); - i += 1; - } -} - - -/* - topologicallyOut - -*/ - -static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, decl_nodeProcedure pt, decl_nodeProcedure pv) -{ - unsigned int tol; - unsigned int pal; - unsigned int to; - unsigned int pa; - - populateTodo ((decl_nodeProcedure) {(decl_nodeProcedure_t) addEnumConst}); - tol = 0; - pal = 0; - to = alists_noOfItemsInList (todoQ); - pa = alists_noOfItemsInList (partialQ); - while ((tol != to) || (pal != pa)) - { - dumpLists (); - tryOutputTodo (c, t, v, tp); - dumpLists (); - tryOutputPartial (pt); - tol = to; - pal = pa; - to = alists_noOfItemsInList (todoQ); - pa = alists_noOfItemsInList (partialQ); - } - dumpLists (); - debugLists (); -} - - -/* - scaffoldStatic - -*/ - -static void scaffoldStatic (mcPretty_pretty p, decl_node n) -{ - outText (p, (const char *) "\\n", 2); - doExternCP (p); - outText (p, (const char *) "void", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "_M2_", 4); - doFQNameC (p, n); - outText (p, (const char *) "_init", 5); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(__attribute__((unused)) int argc", 33); - outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37); - outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40); - p = outKc (p, (const char *) "{\\n", 3); - doStatementsC (p, n->impF.beginStatements); - p = outKc (p, (const char *) "}\\n", 3); - outText (p, (const char *) "\\n", 2); - doExternCP (p); - outText (p, (const char *) "void", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "_M2_", 4); - doFQNameC (p, n); - outText (p, (const char *) "_fini", 5); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(__attribute__((unused)) int argc", 33); - outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37); - outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40); - p = outKc (p, (const char *) "{\\n", 3); - doStatementsC (p, n->impF.finallyStatements); - p = outKc (p, (const char *) "}\\n", 3); -} - - -/* - emitCtor - -*/ - -static void emitCtor (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - outText (p, (const char *) "\\n", 2); - outText (p, (const char *) "static void", 11); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "ctorFunction ()\\n", 17); - doFQNameC (p, n); - p = outKc (p, (const char *) "{\\n", 3); - outText (p, (const char *) "M2RTS_RegisterModule (\"", 23); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - mcPretty_prints (p, s); - outText (p, (const char *) "\",\\n", 4); - outText (p, (const char *) "init, fini, dependencies);\\n", 28); - p = outKc (p, (const char *) "}\\n\\n", 5); - p = outKc (p, (const char *) "struct ", 7); - mcPretty_prints (p, s); - p = outKc (p, (const char *) "_module_m2 { ", 13); - mcPretty_prints (p, s); - p = outKc (p, (const char *) "_module_m2 (); ~", 16); - mcPretty_prints (p, s); - p = outKc (p, (const char *) "_module_m2 (); } global_module_", 31); - mcPretty_prints (p, s); - outText (p, (const char *) ";\\n\\n", 5); - mcPretty_prints (p, s); - p = outKc (p, (const char *) "_module_m2::", 12); - mcPretty_prints (p, s); - p = outKc (p, (const char *) "_module_m2 ()\\n", 15); - p = outKc (p, (const char *) "{\\n", 3); - outText (p, (const char *) "M2RTS_RegisterModule (\"", 23); - mcPretty_prints (p, s); - outText (p, (const char *) "\", init, fini, dependencies);", 29); - p = outKc (p, (const char *) "}\\n", 3); - mcPretty_prints (p, s); - p = outKc (p, (const char *) "_module_m2::~", 13); - mcPretty_prints (p, s); - p = outKc (p, (const char *) "_module_m2 ()\\n", 15); - p = outKc (p, (const char *) "{\\n", 3); - p = outKc (p, (const char *) "}\\n", 3); - s = DynamicStrings_KillString (s); -} - - -/* - scaffoldDynamic - -*/ - -static void scaffoldDynamic (mcPretty_pretty p, decl_node n) -{ - outText (p, (const char *) "\\n", 2); - doExternCP (p); - outText (p, (const char *) "void", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "_M2_", 4); - doFQNameC (p, n); - outText (p, (const char *) "_init", 5); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(__attribute__((unused)) int argc,", 34); - outText (p, (const char *) " __attribute__((unused)) char *argv[]", 37); - outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40); - p = outKc (p, (const char *) "{\\n", 3); - doStatementsC (p, n->impF.beginStatements); - p = outKc (p, (const char *) "}\\n", 3); - outText (p, (const char *) "\\n", 2); - doExternCP (p); - outText (p, (const char *) "void", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "_M2_", 4); - doFQNameC (p, n); - outText (p, (const char *) "_fini", 5); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(__attribute__((unused)) int argc,", 34); - outText (p, (const char *) " __attribute__((unused)) char *argv[]", 37); - outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40); - p = outKc (p, (const char *) "{\\n", 3); - doStatementsC (p, n->impF.finallyStatements); - p = outKc (p, (const char *) "}\\n", 3); - emitCtor (p, n); -} - - -/* - scaffoldMain - -*/ - -static void scaffoldMain (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - outText (p, (const char *) "int\\n", 5); - outText (p, (const char *) "main", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(int argc, char *argv[], char *envp[])\\n", 40); - p = outKc (p, (const char *) "{\\n", 3); - outText (p, (const char *) "M2RTS_ConstructModules (", 24); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - mcPretty_prints (p, s); - outText (p, (const char *) ", argc, argv, envp);\\n", 22); - outText (p, (const char *) "M2RTS_DeconstructModules (", 26); - mcPretty_prints (p, s); - outText (p, (const char *) ", argc, argv, envp);\\n", 22); - outText (p, (const char *) "return 0;", 9); - p = outKc (p, (const char *) "}\\n", 3); - s = DynamicStrings_KillString (s); -} - - -/* - outImpInitC - emit the init/fini functions and main function if required. -*/ - -static void outImpInitC (mcPretty_pretty p, decl_node n) -{ - if (mcOptions_getScaffoldDynamic ()) - { - scaffoldDynamic (p, n); - } - else - { - scaffoldStatic (p, n); - } - if (mcOptions_getScaffoldMain ()) - { - scaffoldMain (p, n); - } -} - - -/* - runSimplifyTypes - -*/ - -static void runSimplifyTypes (decl_node n) -{ - if (decl_isImp (n)) - { - simplifyTypes (n->impF.decls); - } - else if (decl_isModule (n)) - { - /* avoid dangling else. */ - simplifyTypes (n->moduleF.decls); - } - else if (decl_isDef (n)) - { - /* avoid dangling else. */ - simplifyTypes (n->defF.decls); - } -} - - -/* - outDefC - -*/ - -static void outDefC (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - mcDebug_assert (decl_isDef (n)); - outputFile = mcStream_openFrag (1); /* first fragment. */ - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */ - mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) ". */\\n", 7); - mcOptions_writeGPLheader (outputFile); - doCommentC (p, n->defF.com.body); - mcPretty_print (p, (const char *) "\\n\\n#if !defined (_", 19); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) "_H)\\n", 5); - mcPretty_print (p, (const char *) "# define _", 12); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) "_H\\n\\n", 6); - keyc_genConfigSystem (p); - mcPretty_print (p, (const char *) "# ifdef __cplusplus\\n", 23); - mcPretty_print (p, (const char *) "extern \"C\" {\\n", 14); - mcPretty_print (p, (const char *) "# endif\\n", 11); - outputFile = mcStream_openFrag (3); /* third fragment. */ - doP = p; /* third fragment. */ - Indexing_ForeachIndiceInIndexDo (n->defF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC}); - mcPretty_print (p, (const char *) "\\n", 2); - mcPretty_print (p, (const char *) "# if defined (_", 17); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) "_C)\\n", 5); - mcPretty_print (p, (const char *) "# define EXTERN\\n", 22); - mcPretty_print (p, (const char *) "# else\\n", 10); - mcPretty_print (p, (const char *) "# define EXTERN extern\\n", 29); - mcPretty_print (p, (const char *) "# endif\\n\\n", 13); - outDeclsDefC (p, n); - runPrototypeDefC (n); - mcPretty_print (p, (const char *) "# ifdef __cplusplus\\n", 23); - mcPretty_print (p, (const char *) "}\\n", 3); - mcPretty_print (p, (const char *) "# endif\\n", 11); - mcPretty_print (p, (const char *) "\\n", 2); - mcPretty_print (p, (const char *) "# undef EXTERN\\n", 18); - mcPretty_print (p, (const char *) "#endif\\n", 8); - outputFile = mcStream_openFrag (2); /* second fragment. */ - keyc_genDefs (p); /* second fragment. */ - s = DynamicStrings_KillString (s); -} - - -/* - runPrototypeExported - -*/ - -static void runPrototypeExported (decl_node n) -{ - if (decl_isExported (n)) - { - keyc_enterScope (n); - doProcedureHeadingC (n, TRUE); - mcPretty_print (doP, (const char *) ";\\n", 3); - keyc_leaveScope (n); - } -} - - -/* - runPrototypeDefC - -*/ - -static void runPrototypeDefC (decl_node n) -{ - if (decl_isDef (n)) - { - Indexing_ForeachIndiceInIndexDo (n->defF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) runPrototypeExported}); - } -} - - -/* - outImpC - -*/ - -static void outImpC (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - decl_node defModule; - - mcDebug_assert (decl_isImp (n)); - outputFile = mcStream_openFrag (1); /* first fragment. */ - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */ - mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) ". */\\n", 7); - mcOptions_writeGPLheader (outputFile); - doCommentC (p, n->impF.com.body); - outText (p, (const char *) "\\n", 2); - outputFile = mcStream_openFrag (3); /* third fragment. */ - if (mcOptions_getExtendedOpaque ()) /* third fragment. */ - { - doP = p; - /* ForeachIndiceInIndexDo (n^.impF.importedModules, doIncludeC) ; */ - includeExternals (n); - foreachModuleDo (n, (symbolKey_performOperation) {(symbolKey_performOperation_t) runSimplifyTypes}); - libc_printf ((const char *) "/* --extended-opaque seen therefore no #include will be used and everything will be declared in full. */\\n", 108); - decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runIncludeDefConstType}); - includeDefVarProcedure (n); - outDeclsImpC (p, n->impF.decls); - decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runPrototypeDefC}); - } - else - { - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - /* we don't want to include the .h file for this implementation module. */ - mcPretty_print (p, (const char *) "#define _", 9); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) "_H\\n", 4); - mcPretty_print (p, (const char *) "#define _", 9); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) "_C\\n\\n", 6); - s = DynamicStrings_KillString (s); - doP = p; - Indexing_ForeachIndiceInIndexDo (n->impF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC}); - mcPretty_print (p, (const char *) "\\n", 2); - includeDefConstType (n); - includeDefVarProcedure (n); - outDeclsImpC (p, n->impF.decls); - defModule = decl_lookupDef (decl_getSymName (n)); - if (defModule != NULL) - { - runPrototypeDefC (defModule); - } - } - Indexing_ForeachIndiceInIndexDo (n->impF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); - outProceduresC (p, n->impF.decls); - outImpInitC (p, n); - outputFile = mcStream_openFrag (2); /* second fragment. */ - keyc_genConfigSystem (p); /* second fragment. */ - keyc_genDefs (p); -} - - -/* - outDeclsModuleC - -*/ - -static void outDeclsModuleC (mcPretty_pretty p, decl_scopeT s) -{ - simplifyTypes (s); - includeConstType (s); - doP = p; - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}); - /* try and output types, constants before variables and procedures. */ - includeVarProcedure (s); - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}); - Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); -} - - -/* - outModuleInitC - -*/ - -static void outModuleInitC (mcPretty_pretty p, decl_node n) -{ - outText (p, (const char *) "\\n", 2); - doExternCP (p); - outText (p, (const char *) "void", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "_M2_", 4); - doFQNameC (p, n); - outText (p, (const char *) "_init", 5); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(__attribute__((unused)) int argc", 33); - outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37); - outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40); - p = outKc (p, (const char *) "{\\n", 3); - doStatementsC (p, n->moduleF.beginStatements); - p = outKc (p, (const char *) "}\\n", 3); - outText (p, (const char *) "\\n", 2); - doExternCP (p); - outText (p, (const char *) "void", 4); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "_M2_", 4); - doFQNameC (p, n); - outText (p, (const char *) "_fini", 5); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "(__attribute__((unused)) int argc", 33); - outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37); - outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40); - p = outKc (p, (const char *) "{\\n", 3); - doStatementsC (p, n->moduleF.finallyStatements); - p = outKc (p, (const char *) "}\\n", 3); -} - - -/* - outModuleC - -*/ - -static void outModuleC (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - mcDebug_assert (decl_isModule (n)); - outputFile = mcStream_openFrag (1); /* first fragment. */ - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */ - mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) ". */\\n", 7); - mcOptions_writeGPLheader (outputFile); - doCommentC (p, n->moduleF.com.body); - outText (p, (const char *) "\\n", 2); - outputFile = mcStream_openFrag (3); /* third fragment. */ - if (mcOptions_getExtendedOpaque ()) /* third fragment. */ - { - doP = p; - includeExternals (n); - foreachModuleDo (n, (symbolKey_performOperation) {(symbolKey_performOperation_t) runSimplifyTypes}); - libc_printf ((const char *) "/* --extended-opaque seen therefore no #include will be used and everything will be declared in full. */\\n", 108); - decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runIncludeDefConstType}); - outDeclsModuleC (p, n->moduleF.decls); - decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runPrototypeDefC}); - } - else - { - doP = p; - Indexing_ForeachIndiceInIndexDo (n->moduleF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC}); - mcPretty_print (p, (const char *) "\\n", 2); - outDeclsModuleC (p, n->moduleF.decls); - } - Indexing_ForeachIndiceInIndexDo (n->moduleF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); - outProceduresC (p, n->moduleF.decls); - outModuleInitC (p, n); - outputFile = mcStream_openFrag (2); /* second fragment. */ - keyc_genConfigSystem (p); /* second fragment. */ - keyc_genDefs (p); -} - - -/* - outC - -*/ - -static void outC (mcPretty_pretty p, decl_node n) -{ - keyc_enterScope (n); - if (decl_isDef (n)) - { - outDefC (p, n); - } - else if (decl_isImp (n)) - { - /* avoid dangling else. */ - outImpC (p, n); - } - else if (decl_isModule (n)) - { - /* avoid dangling else. */ - outModuleC (p, n); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - keyc_leaveScope (n); -} - - -/* - doIncludeM2 - include modules in module, n. -*/ - -static void doIncludeM2 (decl_node n) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - mcPretty_print (doP, (const char *) "IMPORT ", 7); - mcPretty_prints (doP, s); - mcPretty_print (doP, (const char *) " ;\\n", 4); - s = DynamicStrings_KillString (s); - if (decl_isDef (n)) - { - symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone}); - } - else if (decl_isImp (n)) - { - /* avoid dangling else. */ - symbolKey_foreachNodeDo (n->impF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone}); - } - else if (decl_isModule (n)) - { - /* avoid dangling else. */ - symbolKey_foreachNodeDo (n->moduleF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone}); - } -} - - -/* - doConstM2 - -*/ - -static void doConstM2 (decl_node n) -{ - mcPretty_print (doP, (const char *) "CONST\\n", 7); - doFQNameC (doP, n); - mcPretty_setNeedSpace (doP); - doExprC (doP, n->constF.value); - mcPretty_print (doP, (const char *) "\\n", 2); -} - - -/* - doProcTypeM2 - -*/ - -static void doProcTypeM2 (mcPretty_pretty p, decl_node n) -{ - outText (p, (const char *) "proc type to do..", 17); -} - - -/* - doRecordFieldM2 - -*/ - -static void doRecordFieldM2 (mcPretty_pretty p, decl_node f) -{ - doNameM2 (p, f); - outText (p, (const char *) ":", 1); - mcPretty_setNeedSpace (p); - doTypeM2 (p, decl_getType (f)); - mcPretty_setNeedSpace (p); -} - - -/* - doVarientFieldM2 - -*/ - -static void doVarientFieldM2 (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - mcDebug_assert (decl_isVarientField (n)); - doNameM2 (p, n); - outText (p, (const char *) ":", 1); - mcPretty_setNeedSpace (p); - i = Indexing_LowIndice (n->varientfieldF.listOfSons); - t = Indexing_HighIndice (n->varientfieldF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientfieldF.listOfSons, i)); - if (decl_isRecordField (q)) - { - doRecordFieldM2 (p, q); - outText (p, (const char *) ";\\n", 3); - } - else if (decl_isVarient (q)) - { - /* avoid dangling else. */ - doVarientM2 (p, q); - outText (p, (const char *) ";\\n", 3); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - i += 1; - } -} - - -/* - doVarientM2 - -*/ - -static void doVarientM2 (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - mcDebug_assert (decl_isVarient (n)); - outText (p, (const char *) "CASE", 4); - mcPretty_setNeedSpace (p); - if (n->varientF.tag != NULL) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (decl_isRecordField (n->varientF.tag)) - { - doRecordFieldM2 (p, n->varientF.tag); - } - else if (decl_isVarientField (n->varientF.tag)) - { - /* avoid dangling else. */ - doVarientFieldM2 (p, n->varientF.tag); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - mcPretty_setNeedSpace (p); - outText (p, (const char *) "OF\\n", 4); - i = Indexing_LowIndice (n->varientF.listOfSons); - t = Indexing_HighIndice (n->varientF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); - if (decl_isRecordField (q)) - { - /* avoid dangling else. */ - if (! q->recordfieldF.tag) - { - doRecordFieldM2 (p, q); - outText (p, (const char *) ";\\n", 3); - } - } - else if (decl_isVarientField (q)) - { - /* avoid dangling else. */ - doVarientFieldM2 (p, q); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - i += 1; - } - outText (p, (const char *) "END", 3); - mcPretty_setNeedSpace (p); -} - - -/* - doRecordM2 - -*/ - -static void doRecordM2 (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node f; - - mcDebug_assert (decl_isRecord (n)); - p = outKm2 (p, (const char *) "RECORD", 6); - i = Indexing_LowIndice (n->recordF.listOfSons); - h = Indexing_HighIndice (n->recordF.listOfSons); - outText (p, (const char *) "\\n", 2); - while (i <= h) - { - f = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); - if (decl_isRecordField (f)) - { - /* avoid dangling else. */ - if (! f->recordfieldF.tag) - { - doRecordFieldM2 (p, f); - outText (p, (const char *) ";\\n", 3); - } - } - else if (decl_isVarient (f)) - { - /* avoid dangling else. */ - doVarientM2 (p, f); - outText (p, (const char *) ";\\n", 3); - } - else if (decl_isVarientField (f)) - { - /* avoid dangling else. */ - doVarientFieldM2 (p, f); - } - i += 1; - } - p = outKm2 (p, (const char *) "END", 3); - mcPretty_setNeedSpace (p); -} - - -/* - doPointerM2 - -*/ - -static void doPointerM2 (mcPretty_pretty p, decl_node n) -{ - outText (p, (const char *) "POINTER TO", 10); - mcPretty_setNeedSpace (doP); - doTypeM2 (p, decl_getType (n)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) ";\\n", 3); -} - - -/* - doTypeAliasM2 - -*/ - -static void doTypeAliasM2 (mcPretty_pretty p, decl_node n) -{ - doTypeNameC (p, n); - mcPretty_setNeedSpace (p); - outText (doP, (const char *) "=", 1); - mcPretty_setNeedSpace (p); - doTypeM2 (p, decl_getType (n)); - mcPretty_setNeedSpace (p); - outText (p, (const char *) "\\n", 2); -} - - -/* - doEnumerationM2 - -*/ - -static void doEnumerationM2 (mcPretty_pretty p, decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node s; - DynamicStrings_String t; - - outText (p, (const char *) "(", 1); - i = Indexing_LowIndice (n->enumerationF.listOfSons); - h = Indexing_HighIndice (n->enumerationF.listOfSons); - while (i <= h) - { - s = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); - doFQNameC (p, s); - if (i < h) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - i += 1; - } - outText (p, (const char *) ")", 1); -} - - -/* - doBaseM2 - -*/ - -static void doBaseM2 (mcPretty_pretty p, decl_node n) -{ - switch (n->kind) - { - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_boolean: - case decl_proc: - doNameM2 (p, n); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - mcPretty_setNeedSpace (p); -} - - -/* - doSystemM2 - -*/ - -static void doSystemM2 (mcPretty_pretty p, decl_node n) -{ - switch (n->kind) - { - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - doNameM2 (p, n); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - doTypeM2 - -*/ - -static void doTypeM2 (mcPretty_pretty p, decl_node n) -{ - if (isBase (n)) - { - doBaseM2 (p, n); - } - else if (isSystem (n)) - { - /* avoid dangling else. */ - doSystemM2 (p, n); - } - else if (decl_isType (n)) - { - /* avoid dangling else. */ - doTypeAliasM2 (p, n); - } - else if (decl_isProcType (n)) - { - /* avoid dangling else. */ - doProcTypeM2 (p, n); - } - else if (decl_isPointer (n)) - { - /* avoid dangling else. */ - doPointerM2 (p, n); - } - else if (decl_isEnumeration (n)) - { - /* avoid dangling else. */ - doEnumerationM2 (p, n); - } - else if (decl_isRecord (n)) - { - /* avoid dangling else. */ - doRecordM2 (p, n); - } -} - - -/* - doTypesM2 - -*/ - -static void doTypesM2 (decl_node n) -{ - decl_node m; - - outText (doP, (const char *) "TYPE\\n", 6); - doTypeM2 (doP, n); -} - - -/* - doVarM2 - -*/ - -static void doVarM2 (decl_node n) -{ - mcDebug_assert (decl_isVar (n)); - doNameC (doP, n); - outText (doP, (const char *) ":", 1); - mcPretty_setNeedSpace (doP); - doTypeM2 (doP, decl_getType (n)); - mcPretty_setNeedSpace (doP); - outText (doP, (const char *) ";\\n", 3); -} - - -/* - doVarsM2 - -*/ - -static void doVarsM2 (decl_node n) -{ - decl_node m; - - outText (doP, (const char *) "VAR\\n", 5); - doVarM2 (n); -} - - -/* - doTypeNameM2 - -*/ - -static void doTypeNameM2 (mcPretty_pretty p, decl_node n) -{ - doNameM2 (p, n); -} - - -/* - doParamM2 - -*/ - -static void doParamM2 (mcPretty_pretty p, decl_node n) -{ - decl_node ptype; - nameKey_Name i; - unsigned int c; - unsigned int t; - wlists_wlist l; - - mcDebug_assert (decl_isParam (n)); - ptype = decl_getType (n); - if (n->paramF.namelist == NULL) - { - doTypeNameM2 (p, ptype); - } - else - { - mcDebug_assert (isIdentList (n->paramF.namelist)); - l = n->paramF.namelist->identlistF.names; - if (l == NULL) - { - doTypeNameM2 (p, ptype); - } - else - { - t = wlists_noOfItemsInList (l); - c = 1; - while (c <= t) - { - i = static_cast (wlists_getItemFromList (l, c)); - mcPretty_setNeedSpace (p); - doNamesC (p, i); - if (c < t) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - c += 1; - } - outText (p, (const char *) ":", 1); - mcPretty_setNeedSpace (p); - doTypeNameM2 (p, ptype); - } - } -} - - -/* - doVarParamM2 - -*/ - -static void doVarParamM2 (mcPretty_pretty p, decl_node n) -{ - decl_node ptype; - nameKey_Name i; - unsigned int c; - unsigned int t; - wlists_wlist l; - - mcDebug_assert (decl_isVarParam (n)); - outText (p, (const char *) "VAR", 3); - mcPretty_setNeedSpace (p); - ptype = decl_getType (n); - if (n->varparamF.namelist == NULL) - { - doTypeNameM2 (p, ptype); - } - else - { - mcDebug_assert (isIdentList (n->varparamF.namelist)); - l = n->varparamF.namelist->identlistF.names; - if (l == NULL) - { - doTypeNameM2 (p, ptype); - } - else - { - t = wlists_noOfItemsInList (l); - c = 1; - while (c <= t) - { - i = static_cast (wlists_getItemFromList (l, c)); - mcPretty_setNeedSpace (p); - doNamesC (p, i); - if (c < t) - { - outText (p, (const char *) ",", 1); - mcPretty_setNeedSpace (p); - } - c += 1; - } - outText (p, (const char *) ":", 1); - mcPretty_setNeedSpace (p); - doTypeNameM2 (p, ptype); - } - } -} - - -/* - doParameterM2 - -*/ - -static void doParameterM2 (mcPretty_pretty p, decl_node n) -{ - if (decl_isParam (n)) - { - doParamM2 (p, n); - } - else if (decl_isVarParam (n)) - { - /* avoid dangling else. */ - doVarParamM2 (p, n); - } - else if (decl_isVarargs (n)) - { - /* avoid dangling else. */ - mcPretty_print (p, (const char *) "...", 3); - } -} - - -/* - doPrototypeM2 - -*/ - -static void doPrototypeM2 (decl_node n) -{ - unsigned int i; - unsigned int h; - decl_node p; - - mcDebug_assert (decl_isProcedure (n)); - mcPretty_noSpace (doP); - doNameM2 (doP, n); - mcPretty_setNeedSpace (doP); - outText (doP, (const char *) "(", 1); - i = Indexing_LowIndice (n->procedureF.parameters); - h = Indexing_HighIndice (n->procedureF.parameters); - while (i <= h) - { - p = static_cast (Indexing_GetIndice (n->procedureF.parameters, i)); - doParameterM2 (doP, p); - mcPretty_noSpace (doP); - if (i < h) - { - mcPretty_print (doP, (const char *) ";", 1); - mcPretty_setNeedSpace (doP); - } - i += 1; - } - outText (doP, (const char *) ")", 1); - if (n->procedureF.returnType != NULL) - { - mcPretty_setNeedSpace (doP); - outText (doP, (const char *) ":", 1); - doTypeM2 (doP, n->procedureF.returnType); - mcPretty_setNeedSpace (doP); - } - outText (doP, (const char *) ";\\n", 3); -} - - -/* - outputPartialM2 - just writes out record, array, and proctypes. - No need for forward declarations in Modula-2 - but we need to keep topological sort happy. - So when asked to output partial we emit the - full type for these types and then do nothing - when trying to complete partial to full. -*/ - -static void outputPartialM2 (decl_node n) -{ - decl_node q; - - q = decl_getType (n); - if (decl_isRecord (q)) - { - doTypeM2 (doP, n); - } - else if (decl_isArray (q)) - { - /* avoid dangling else. */ - doTypeM2 (doP, n); - } - else if (decl_isProcType (q)) - { - /* avoid dangling else. */ - doTypeM2 (doP, n); - } -} - - -/* - outDeclsDefM2 - -*/ - -static void outDeclsDefM2 (mcPretty_pretty p, decl_scopeT s) -{ - simplifyTypes (s); - includeConstType (s); - doP = p; - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}); - includeVarProcedure (s); - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}); - Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeM2}); -} - - -/* - outDefM2 - -*/ - -static void outDefM2 (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSource (n))); - mcPretty_print (p, (const char *) "(* automatically created by mc from ", 36); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) ". *)\\n\\n", 9); - s = DynamicStrings_KillString (s); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - mcPretty_print (p, (const char *) "DEFINITION MODULE ", 18); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) " ;\\n\\n", 6); - doP = p; - Indexing_ForeachIndiceInIndexDo (n->defF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeM2}); - mcPretty_print (p, (const char *) "\\n", 2); - outDeclsDefM2 (p, n->defF.decls); - mcPretty_print (p, (const char *) "\\n", 2); - mcPretty_print (p, (const char *) "END ", 4); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) ".\\n", 3); - s = DynamicStrings_KillString (s); -} - - -/* - outDeclsImpM2 - -*/ - -static void outDeclsImpM2 (mcPretty_pretty p, decl_scopeT s) -{ - simplifyTypes (s); - includeConstType (s); - doP = p; - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}); - includeVarProcedure (s); - topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}); - outText (p, (const char *) "\\n", 2); - Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC}); -} - - -/* - outImpM2 - -*/ - -static void outImpM2 (mcPretty_pretty p, decl_node n) -{ - DynamicStrings_String s; - - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSource (n))); - mcPretty_print (p, (const char *) "(* automatically created by mc from ", 36); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) ". *)\\n\\n", 9); - mcPretty_print (p, (const char *) "IMPLEMENTATION MODULE ", 22); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) " ;\\n\\n", 6); - doP = p; - Indexing_ForeachIndiceInIndexDo (n->impF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeM2}); - mcPretty_print (p, (const char *) "\\n", 2); - includeDefConstType (n); - outDeclsImpM2 (p, n->impF.decls); - mcPretty_print (p, (const char *) "\\n", 2); - mcPretty_print (p, (const char *) "END ", 4); - mcPretty_prints (p, s); - mcPretty_print (p, (const char *) ".\\n", 3); - s = DynamicStrings_KillString (s); -} - - -/* - outModuleM2 - -*/ - -static void outModuleM2 (mcPretty_pretty p, decl_node n) -{ -} - - -/* - outM2 - -*/ - -static void outM2 (mcPretty_pretty p, decl_node n) -{ - if (decl_isDef (n)) - { - outDefM2 (p, n); - } - else if (decl_isImp (n)) - { - /* avoid dangling else. */ - outImpM2 (p, n); - } - else if (decl_isModule (n)) - { - /* avoid dangling else. */ - outModuleM2 (p, n); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - addDone - adds node, n, to the doneQ. -*/ - -static void addDone (decl_node n) -{ - alists_includeItemIntoList (doneQ, reinterpret_cast (n)); -} - - -/* - addDoneDef - adds node, n, to the doneQ providing - it is not an opaque of the main module we are compiling. -*/ - -static void addDoneDef (decl_node n) -{ - if (decl_isDef (n)) - { - addDone (n); - return ; - } - if ((! (decl_isDef (n))) && ((decl_lookupImp (decl_getSymName (decl_getScope (n)))) == (decl_getMainModule ()))) - { - mcMetaError_metaError1 ((const char *) "cyclic dependancy found between another module using {%1ad} from the definition module of the implementation main being compiled, use the --extended-opaque option to compile", 173, (const unsigned char *) &n, (sizeof (n)-1)); - mcError_flushErrors (); - mcError_errorAbort0 ((const char *) "terminating compilation", 23); - } - else - { - addDone (n); - } -} - - -/* - dbgAdd - -*/ - -static decl_node dbgAdd (alists_alist l, decl_node n) -{ - if (n != NULL) - { - alists_includeItemIntoList (l, reinterpret_cast (n)); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dbgType - -*/ - -static void dbgType (alists_alist l, decl_node n) -{ - decl_node t; - - t = dbgAdd (l, decl_getType (n)); - out1 ((const char *) "<%s type", 8, n); - if (t == NULL) - { - out0 ((const char *) ", type = NIL\\n", 14); - } - else - { - out1 ((const char *) ", type = %s>\\n", 14, t); - } -} - - -/* - dbgPointer - -*/ - -static void dbgPointer (alists_alist l, decl_node n) -{ - decl_node t; - - t = dbgAdd (l, decl_getType (n)); - out1 ((const char *) "<%s pointer", 11, n); - out1 ((const char *) " to %s>\\n", 9, t); -} - - -/* - dbgRecord - -*/ - -static void dbgRecord (alists_alist l, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - out1 ((const char *) "<%s record:\\n", 13, n); - i = Indexing_LowIndice (n->recordF.listOfSons); - t = Indexing_HighIndice (n->recordF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->recordF.listOfSons, i)); - if (decl_isRecordField (q)) - { - out1 ((const char *) " \\n", 7, q); - i += 1; - } - outText (doP, (const char *) ">\\n", 3); -} - - -/* - dbgVarient - -*/ - -static void dbgVarient (alists_alist l, decl_node n) -{ - unsigned int i; - unsigned int t; - decl_node q; - - out1 ((const char *) "<%s varient: ", 13, n); - out1 ((const char *) "tag %s", 6, n->varientF.tag); - q = decl_getType (n->varientF.tag); - if (q == NULL) - { - outText (doP, (const char *) "\\n", 2); - } - else - { - out1 ((const char *) ": %s\\n", 6, q); - q = dbgAdd (l, q); - } - i = Indexing_LowIndice (n->varientF.listOfSons); - t = Indexing_HighIndice (n->varientF.listOfSons); - while (i <= t) - { - q = static_cast (Indexing_GetIndice (n->varientF.listOfSons, i)); - if (decl_isRecordField (q)) - { - out1 ((const char *) " \\n", 7, q); - i += 1; - } - outText (doP, (const char *) ">\\n", 3); -} - - -/* - dbgEnumeration - -*/ - -static void dbgEnumeration (alists_alist l, decl_node n) -{ - decl_node e; - unsigned int i; - unsigned int h; - - outText (doP, (const char *) "< enumeration ", 14); - i = Indexing_LowIndice (n->enumerationF.listOfSons); - h = Indexing_HighIndice (n->enumerationF.listOfSons); - while (i <= h) - { - e = static_cast (Indexing_GetIndice (n->enumerationF.listOfSons, i)); - out1 ((const char *) "%s, ", 4, e); - i += 1; - } - outText (doP, (const char *) ">\\n", 3); -} - - -/* - dbgVar - -*/ - -static void dbgVar (alists_alist l, decl_node n) -{ - decl_node t; - - t = dbgAdd (l, decl_getType (n)); - out1 ((const char *) "<%s var", 7, n); - out1 ((const char *) ", type = %s>\\n", 14, t); -} - - -/* - dbgSubrange - -*/ - -static void dbgSubrange (alists_alist l, decl_node n) -{ - if (n->subrangeF.low == NULL) - { - out1 ((const char *) "%s", 2, n->subrangeF.type); - } - else - { - out1 ((const char *) "[%s", 3, n->subrangeF.low); - out1 ((const char *) "..%s]", 5, n->subrangeF.high); - } -} - - -/* - dbgArray - -*/ - -static void dbgArray (alists_alist l, decl_node n) -{ - decl_node t; - - t = dbgAdd (l, decl_getType (n)); - out1 ((const char *) "<%s array ", 10, n); - if (n->arrayF.subr != NULL) - { - dbgSubrange (l, n->arrayF.subr); - } - out1 ((const char *) " of %s>\\n", 9, t); -} - - -/* - doDbg - -*/ - -static void doDbg (alists_alist l, decl_node n) -{ - if (n == NULL) - {} /* empty. */ - else if (decl_isSubrange (n)) - { - /* avoid dangling else. */ - dbgSubrange (l, n); - } - else if (decl_isType (n)) - { - /* avoid dangling else. */ - dbgType (l, n); - } - else if (decl_isRecord (n)) - { - /* avoid dangling else. */ - dbgRecord (l, n); - } - else if (decl_isVarient (n)) - { - /* avoid dangling else. */ - dbgVarient (l, n); - } - else if (decl_isEnumeration (n)) - { - /* avoid dangling else. */ - dbgEnumeration (l, n); - } - else if (decl_isPointer (n)) - { - /* avoid dangling else. */ - dbgPointer (l, n); - } - else if (decl_isArray (n)) - { - /* avoid dangling else. */ - dbgArray (l, n); - } - else if (decl_isVar (n)) - { - /* avoid dangling else. */ - dbgVar (l, n); - } -} - - -/* - dbg - -*/ - -static void dbg (decl_node n) -{ - alists_alist l; - mcPretty_pretty o; - FIO_File f; - DynamicStrings_String s; - unsigned int i; - - o = doP; - f = outputFile; - outputFile = FIO_StdOut; - doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln}); - l = alists_initList (); - alists_includeItemIntoList (l, reinterpret_cast (n)); - i = 1; - out1 ((const char *) "dbg (%s)\\n", 10, n); - do { - n = static_cast (alists_getItemFromList (l, i)); - doDbg (l, n); - i += 1; - } while (! (i > (alists_noOfItemsInList (l)))); - doP = o; - outputFile = f; -} - - -/* - addGenericBody - adds comment node to funccall, return, assignment - nodes. -*/ - -static void addGenericBody (decl_node n, decl_node c) -{ - switch (n->kind) - { - case decl_unreachable: - case decl_throw: - case decl_halt: - case decl_new: - case decl_dispose: - case decl_inc: - case decl_dec: - case decl_incl: - case decl_excl: - n->intrinsicF.intrinsicComment.body = c; - break; - - case decl_funccall: - n->funccallF.funccallComment.body = c; - break; - - case decl_return: - n->returnF.returnComment.body = c; - break; - - case decl_assignment: - n->assignmentF.assignComment.body = c; - break; - - case decl_module: - n->moduleF.com.body = c; - break; - - case decl_def: - n->defF.com.body = c; - break; - - case decl_imp: - n->impF.com.body = c; - break; - - - default: - break; - } -} - - -/* - addGenericAfter - adds comment node to funccall, return, assignment - nodes. -*/ - -static void addGenericAfter (decl_node n, decl_node c) -{ - switch (n->kind) - { - case decl_unreachable: - case decl_throw: - case decl_halt: - case decl_new: - case decl_dispose: - case decl_inc: - case decl_dec: - case decl_incl: - case decl_excl: - n->intrinsicF.intrinsicComment.after = c; - break; - - case decl_funccall: - n->funccallF.funccallComment.after = c; - break; - - case decl_return: - n->returnF.returnComment.after = c; - break; - - case decl_assignment: - n->assignmentF.assignComment.after = c; - break; - - case decl_module: - n->moduleF.com.after = c; - break; - - case decl_def: - n->defF.com.after = c; - break; - - case decl_imp: - n->impF.com.after = c; - break; - - - default: - break; - } -} - - -/* - isAssignment - -*/ - -static unsigned int isAssignment (decl_node n) -{ - return n->kind == decl_assignment; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isComment - returns TRUE if node, n, is a comment. -*/ - -static unsigned int isComment (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_comment; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - initPair - initialise the commentPair, c. -*/ - -static void initPair (decl_commentPair *c) -{ - (*c).after = NULL; - (*c).body = NULL; -} - - -/* - dupExplist - -*/ - -static decl_node dupExplist (decl_node n) -{ - decl_node m; - unsigned int i; - - mcDebug_assert (decl_isExpList (n)); - m = decl_makeExpList (); - i = Indexing_LowIndice (n->explistF.exp); - while (i <= (Indexing_HighIndice (n->explistF.exp))) - { - decl_putExpList (m, decl_dupExpr (reinterpret_cast (Indexing_GetIndice (n->explistF.exp, i)))); - i += 1; - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dupArrayref - -*/ - -static decl_node dupArrayref (decl_node n) -{ - mcDebug_assert (isArrayRef (n)); - return decl_makeArrayRef (decl_dupExpr (n->arrayrefF.array), decl_dupExpr (n->arrayrefF.index)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dupPointerref - -*/ - -static decl_node dupPointerref (decl_node n) -{ - mcDebug_assert (decl_isPointerRef (n)); - return decl_makePointerRef (decl_dupExpr (n->pointerrefF.ptr), decl_dupExpr (n->pointerrefF.field)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dupComponentref - -*/ - -static decl_node dupComponentref (decl_node n) -{ - mcDebug_assert (isComponentRef (n)); - return doMakeComponentRef (decl_dupExpr (n->componentrefF.rec), decl_dupExpr (n->componentrefF.field)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dupBinary - -*/ - -static decl_node dupBinary (decl_node n) -{ - /* assert (isBinary (n)) ; */ - return makeBinary (n->kind, decl_dupExpr (n->binaryF.left), decl_dupExpr (n->binaryF.right), n->binaryF.resultType); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dupUnary - -*/ - -static decl_node dupUnary (decl_node n) -{ - /* assert (isUnary (n)) ; */ - return makeUnary (n->kind, decl_dupExpr (n->unaryF.arg), n->unaryF.resultType); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dupFunccall - -*/ - -static decl_node dupFunccall (decl_node n) -{ - decl_node m; - - mcDebug_assert (isFuncCall (n)); - m = decl_makeFuncCall (decl_dupExpr (n->funccallF.function), decl_dupExpr (n->funccallF.args)); - m->funccallF.type = n->funccallF.type; - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dupSetValue - -*/ - -static decl_node dupSetValue (decl_node n) -{ - decl_node m; - unsigned int i; - - m = newNode (decl_setvalue); - m->setvalueF.type = n->setvalueF.type; - i = Indexing_LowIndice (n->setvalueF.values); - while (i <= (Indexing_HighIndice (n->setvalueF.values))) - { - m = decl_putSetValue (m, decl_dupExpr (reinterpret_cast (Indexing_GetIndice (n->setvalueF.values, i)))); - i += 1; - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doDupExpr - -*/ - -static decl_node doDupExpr (decl_node n) -{ - mcDebug_assert (n != NULL); - switch (n->kind) - { - case decl_explist: - return dupExplist (n); - break; - - case decl_exit: - case decl_return: - case decl_stmtseq: - case decl_comment: - M2RTS_HALT (-1); /* should not be duplicating code. */ - __builtin_unreachable (); - break; - - case decl_length: - M2RTS_HALT (-1); /* length should have been converted into unary. */ - __builtin_unreachable (); - break; - - case decl_nil: - case decl_true: - case decl_false: - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - case decl_boolean: - case decl_proc: - case decl_char: - case decl_integer: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_longint: - case decl_shortint: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_ztype: - case decl_rtype: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - /* base types. */ - return n; - break; - - case decl_type: - case decl_record: - case decl_varient: - case decl_var: - case decl_enumeration: - case decl_subrange: - case decl_subscript: - case decl_array: - case decl_string: - case decl_const: - case decl_literal: - case decl_varparam: - case decl_param: - case decl_varargs: - case decl_optarg: - case decl_pointer: - case decl_recordfield: - case decl_varientfield: - case decl_enumerationfield: - case decl_set: - case decl_proctype: - /* language features and compound type attributes. */ - return n; - break; - - case decl_procedure: - case decl_def: - case decl_imp: - case decl_module: - /* blocks. */ - return n; - break; - - case decl_loop: - case decl_while: - case decl_for: - case decl_repeat: - case decl_case: - case decl_caselabellist: - case decl_caselist: - case decl_range: - case decl_if: - case decl_elsif: - case decl_assignment: - /* statements. */ - return n; - break; - - case decl_arrayref: - /* expressions. */ - return dupArrayref (n); - break; - - case decl_pointerref: - return dupPointerref (n); - break; - - case decl_componentref: - return dupComponentref (n); - break; - - case decl_cmplx: - case decl_and: - case decl_or: - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - case decl_cast: - case decl_val: - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - case decl_in: - return dupBinary (n); - break; - - case decl_re: - case decl_im: - case decl_constexp: - case decl_deref: - case decl_abs: - case decl_chr: - case decl_cap: - case decl_high: - case decl_float: - case decl_trunc: - case decl_ord: - case decl_not: - case decl_neg: - case decl_adr: - case decl_size: - case decl_tsize: - case decl_min: - case decl_max: - return dupUnary (n); - break; - - case decl_identlist: - return n; - break; - - case decl_vardecl: - return n; - break; - - case decl_funccall: - return dupFunccall (n); - break; - - case decl_setvalue: - return dupSetValue (n); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - makeSystem - -*/ - -static void makeSystem (void) -{ - systemN = decl_lookupDef (nameKey_makeKey ((const char *) "SYSTEM", 6)); - addressN = makeBase (decl_address); - locN = makeBase (decl_loc); - byteN = makeBase (decl_byte); - wordN = makeBase (decl_word); - csizetN = makeBase (decl_csizet); - cssizetN = makeBase (decl_cssizet); - adrN = makeBase (decl_adr); - tsizeN = makeBase (decl_tsize); - throwN = makeBase (decl_throw); - decl_enterScope (systemN); - addressN = addToScope (addressN); - locN = addToScope (locN); - byteN = addToScope (byteN); - wordN = addToScope (wordN); - csizetN = addToScope (csizetN); - cssizetN = addToScope (cssizetN); - adrN = addToScope (adrN); - tsizeN = addToScope (tsizeN); - throwN = addToScope (throwN); - mcDebug_assert (sizeN != NULL); /* assumed to be built already. */ - sizeN = addToScope (sizeN); /* also export size from system. */ - decl_leaveScope (); /* also export size from system. */ - addDone (addressN); - addDone (locN); - addDone (byteN); - addDone (wordN); - addDone (csizetN); - addDone (cssizetN); -} - - -/* - makeM2rts - -*/ - -static void makeM2rts (void) -{ - m2rtsN = decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5)); -} - - -/* - makeBitnum - -*/ - -static decl_node makeBitnum (void) -{ - decl_node b; - - b = newNode (decl_subrange); - b->subrangeF.type = NULL; - b->subrangeF.scope = NULL; - b->subrangeF.low = lookupConst (b, nameKey_makeKey ((const char *) "0", 1)); - b->subrangeF.high = lookupConst (b, nameKey_makeKey ((const char *) "31", 2)); - return b; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeBaseSymbols - -*/ - -static void makeBaseSymbols (void) -{ - baseSymbols = symbolKey_initTree (); - booleanN = makeBase (decl_boolean); - charN = makeBase (decl_char); - procN = makeBase (decl_proc); - cardinalN = makeBase (decl_cardinal); - longcardN = makeBase (decl_longcard); - shortcardN = makeBase (decl_shortcard); - integerN = makeBase (decl_integer); - longintN = makeBase (decl_longint); - shortintN = makeBase (decl_shortint); - bitsetN = makeBase (decl_bitset); - bitnumN = makeBitnum (); - ztypeN = makeBase (decl_ztype); - rtypeN = makeBase (decl_rtype); - complexN = makeBase (decl_complex); - longcomplexN = makeBase (decl_longcomplex); - shortcomplexN = makeBase (decl_shortcomplex); - realN = makeBase (decl_real); - longrealN = makeBase (decl_longreal); - shortrealN = makeBase (decl_shortreal); - nilN = makeBase (decl_nil); - trueN = makeBase (decl_true); - falseN = makeBase (decl_false); - sizeN = makeBase (decl_size); - minN = makeBase (decl_min); - maxN = makeBase (decl_max); - floatN = makeBase (decl_float); - truncN = makeBase (decl_trunc); - ordN = makeBase (decl_ord); - valN = makeBase (decl_val); - chrN = makeBase (decl_chr); - capN = makeBase (decl_cap); - absN = makeBase (decl_abs); - newN = makeBase (decl_new); - disposeN = makeBase (decl_dispose); - lengthN = makeBase (decl_length); - incN = makeBase (decl_inc); - decN = makeBase (decl_dec); - inclN = makeBase (decl_incl); - exclN = makeBase (decl_excl); - highN = makeBase (decl_high); - imN = makeBase (decl_im); - reN = makeBase (decl_re); - cmplxN = makeBase (decl_cmplx); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BOOLEAN", 7), reinterpret_cast (booleanN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "PROC", 4), reinterpret_cast (procN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHAR", 4), reinterpret_cast (charN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CARDINAL", 8), reinterpret_cast (cardinalN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCARD", 9), reinterpret_cast (shortcardN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCARD", 8), reinterpret_cast (longcardN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INTEGER", 7), reinterpret_cast (integerN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGINT", 7), reinterpret_cast (longintN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTINT", 8), reinterpret_cast (shortintN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BITSET", 6), reinterpret_cast (bitsetN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "REAL", 4), reinterpret_cast (realN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTREAL", 9), reinterpret_cast (shortrealN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGREAL", 8), reinterpret_cast (longrealN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "COMPLEX", 7), reinterpret_cast (complexN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCOMPLEX", 11), reinterpret_cast (longcomplexN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12), reinterpret_cast (shortcomplexN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NIL", 3), reinterpret_cast (nilN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUE", 4), reinterpret_cast (trueN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FALSE", 5), reinterpret_cast (falseN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SIZE", 4), reinterpret_cast (sizeN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MIN", 3), reinterpret_cast (minN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MAX", 3), reinterpret_cast (maxN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FLOAT", 5), reinterpret_cast (floatN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUNC", 5), reinterpret_cast (truncN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ORD", 3), reinterpret_cast (ordN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "VAL", 3), reinterpret_cast (valN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHR", 3), reinterpret_cast (chrN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CAP", 3), reinterpret_cast (capN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ABS", 3), reinterpret_cast (absN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NEW", 3), reinterpret_cast (newN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DISPOSE", 7), reinterpret_cast (disposeN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LENGTH", 6), reinterpret_cast (lengthN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INC", 3), reinterpret_cast (incN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DEC", 3), reinterpret_cast (decN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INCL", 4), reinterpret_cast (inclN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "EXCL", 4), reinterpret_cast (exclN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "HIGH", 4), reinterpret_cast (highN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CMPLX", 5), reinterpret_cast (cmplxN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "RE", 2), reinterpret_cast (reN)); - symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "IM", 2), reinterpret_cast (imN)); - addDone (booleanN); - addDone (charN); - addDone (cardinalN); - addDone (longcardN); - addDone (shortcardN); - addDone (integerN); - addDone (longintN); - addDone (shortintN); - addDone (bitsetN); - addDone (bitnumN); - addDone (ztypeN); - addDone (rtypeN); - addDone (realN); - addDone (longrealN); - addDone (shortrealN); - addDone (complexN); - addDone (longcomplexN); - addDone (shortcomplexN); - addDone (procN); - addDone (nilN); - addDone (trueN); - addDone (falseN); -} - - -/* - makeBuiltins - -*/ - -static void makeBuiltins (void) -{ - bitsperunitN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "8", 1)); - bitsperwordN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "32", 2)); - bitspercharN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "8", 1)); - unitsperwordN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "4", 1)); - addDone (bitsperunitN); - addDone (bitsperwordN); - addDone (bitspercharN); - addDone (unitsperwordN); -} - - -/* - init - -*/ - -static void init (void) -{ - lang = decl_ansiC; - outputFile = FIO_StdOut; - doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln}); - todoQ = alists_initList (); - partialQ = alists_initList (); - doneQ = alists_initList (); - modUniverse = symbolKey_initTree (); - defUniverse = symbolKey_initTree (); - modUniverseI = Indexing_InitIndex (1); - defUniverseI = Indexing_InitIndex (1); - scopeStack = Indexing_InitIndex (1); - makeBaseSymbols (); - makeSystem (); - makeBuiltins (); - makeM2rts (); - outputState = decl_punct; - tempCount = 0; - mustVisitScope = FALSE; -} - - -/* - getDeclaredMod - returns the token number associated with the nodes declaration - in the implementation or program module. -*/ - -extern "C" unsigned int decl_getDeclaredMod (decl_node n) -{ - return n->at.modDeclared; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getDeclaredDef - returns the token number associated with the nodes declaration - in the definition module. -*/ - -extern "C" unsigned int decl_getDeclaredDef (decl_node n) -{ - return n->at.defDeclared; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getFirstUsed - returns the token number associated with the first use of - node, n. -*/ - -extern "C" unsigned int decl_getFirstUsed (decl_node n) -{ - return n->at.firstUsed; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isDef - return TRUE if node, n, is a definition module. -*/ - -extern "C" unsigned int decl_isDef (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_def; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isImp - return TRUE if node, n, is an implementation module. -*/ - -extern "C" unsigned int decl_isImp (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_imp; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isImpOrModule - returns TRUE if, n, is a program module or implementation module. -*/ - -extern "C" unsigned int decl_isImpOrModule (decl_node n) -{ - return (decl_isImp (n)) || (decl_isModule (n)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isVisited - returns TRUE if the node was visited. -*/ - -extern "C" unsigned int decl_isVisited (decl_node n) -{ - switch (n->kind) - { - case decl_def: - return n->defF.visited; - break; - - case decl_imp: - return n->impF.visited; - break; - - case decl_module: - return n->moduleF.visited; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - unsetVisited - unset the visited flag on a def/imp/module node. -*/ - -extern "C" void decl_unsetVisited (decl_node n) -{ - switch (n->kind) - { - case decl_def: - n->defF.visited = FALSE; - break; - - case decl_imp: - n->impF.visited = FALSE; - break; - - case decl_module: - n->moduleF.visited = FALSE; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - setVisited - set the visited flag on a def/imp/module node. -*/ - -extern "C" void decl_setVisited (decl_node n) -{ - switch (n->kind) - { - case decl_def: - n->defF.visited = TRUE; - break; - - case decl_imp: - n->impF.visited = TRUE; - break; - - case decl_module: - n->moduleF.visited = TRUE; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - setEnumsComplete - sets the field inside the def or imp or module, n. -*/ - -extern "C" void decl_setEnumsComplete (decl_node n) -{ - switch (n->kind) - { - case decl_def: - n->defF.enumsComplete = TRUE; - break; - - case decl_imp: - n->impF.enumsComplete = TRUE; - break; - - case decl_module: - n->moduleF.enumsComplete = TRUE; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - getEnumsComplete - gets the field from the def or imp or module, n. -*/ - -extern "C" unsigned int decl_getEnumsComplete (decl_node n) -{ - switch (n->kind) - { - case decl_def: - return n->defF.enumsComplete; - break; - - case decl_imp: - return n->impF.enumsComplete; - break; - - case decl_module: - return n->moduleF.enumsComplete; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - resetEnumPos - resets the index into the saved list of enums inside - module, n. -*/ - -extern "C" void decl_resetEnumPos (decl_node n) -{ - mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n))); - if (decl_isDef (n)) - { - n->defF.enumFixup.count = 0; - } - else if (decl_isImp (n)) - { - /* avoid dangling else. */ - n->impF.enumFixup.count = 0; - } - else if (decl_isModule (n)) - { - /* avoid dangling else. */ - n->moduleF.enumFixup.count = 0; - } -} - - -/* - getNextEnum - returns the next enumeration node. -*/ - -extern "C" decl_node decl_getNextEnum (void) -{ - decl_node n; - - n = NULL; - mcDebug_assert (((decl_isDef (currentModule)) || (decl_isImp (currentModule))) || (decl_isModule (currentModule))); - if (decl_isDef (currentModule)) - { - n = getNextFixup (¤tModule->defF.enumFixup); - } - else if (decl_isImp (currentModule)) - { - /* avoid dangling else. */ - n = getNextFixup (¤tModule->impF.enumFixup); - } - else if (decl_isModule (currentModule)) - { - /* avoid dangling else. */ - n = getNextFixup (¤tModule->moduleF.enumFixup); - } - mcDebug_assert (n != NULL); - mcDebug_assert ((decl_isEnumeration (n)) || (decl_isEnumerationField (n))); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isModule - return TRUE if node, n, is a program module. -*/ - -extern "C" unsigned int decl_isModule (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_module; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isMainModule - return TRUE if node, n, is the main module specified - by the source file. This might be a definition, - implementation or program module. -*/ - -extern "C" unsigned int decl_isMainModule (decl_node n) -{ - mcDebug_assert (n != NULL); - return n == mainModule; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setMainModule - sets node, n, as the main module to be compiled. -*/ - -extern "C" void decl_setMainModule (decl_node n) -{ - mcDebug_assert (n != NULL); - mainModule = n; -} - - -/* - setCurrentModule - sets node, n, as the current module being compiled. -*/ - -extern "C" void decl_setCurrentModule (decl_node n) -{ - mcDebug_assert (n != NULL); - currentModule = n; -} - - -/* - lookupDef - returns a definition module node named, n. -*/ - -extern "C" decl_node decl_lookupDef (nameKey_Name n) -{ - decl_node d; - - d = static_cast (symbolKey_getSymKey (defUniverse, n)); - if (d == NULL) - { - d = makeDef (n); - symbolKey_putSymKey (defUniverse, n, reinterpret_cast (d)); - Indexing_IncludeIndiceIntoIndex (defUniverseI, reinterpret_cast (d)); - } - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - lookupImp - returns an implementation module node named, n. -*/ - -extern "C" decl_node decl_lookupImp (nameKey_Name n) -{ - decl_node m; - - m = static_cast (symbolKey_getSymKey (modUniverse, n)); - if (m == NULL) - { - m = makeImp (n); - symbolKey_putSymKey (modUniverse, n, reinterpret_cast (m)); - Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast (m)); - } - mcDebug_assert (! (decl_isModule (m))); - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - lookupModule - returns a module node named, n. -*/ - -extern "C" decl_node decl_lookupModule (nameKey_Name n) -{ - decl_node m; - - m = static_cast (symbolKey_getSymKey (modUniverse, n)); - if (m == NULL) - { - m = makeModule (n); - symbolKey_putSymKey (modUniverse, n, reinterpret_cast (m)); - Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast (m)); - } - mcDebug_assert (! (decl_isImp (m))); - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putDefForC - the definition module was defined FOR "C". -*/ - -extern "C" void decl_putDefForC (decl_node n) -{ - mcDebug_assert (decl_isDef (n)); - n->defF.forC = TRUE; -} - - -/* - lookupInScope - looks up a symbol named, n, from, scope. -*/ - -extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n) -{ - switch (scope->kind) - { - case decl_def: - return static_cast (symbolKey_getSymKey (scope->defF.decls.symbols, n)); - break; - - case decl_module: - return static_cast (symbolKey_getSymKey (scope->moduleF.decls.symbols, n)); - break; - - case decl_imp: - return static_cast (symbolKey_getSymKey (scope->impF.decls.symbols, n)); - break; - - case decl_procedure: - return static_cast (symbolKey_getSymKey (scope->procedureF.decls.symbols, n)); - break; - - case decl_record: - return static_cast (symbolKey_getSymKey (scope->recordF.localSymbols, n)); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isConst - returns TRUE if node, n, is a const. -*/ - -extern "C" unsigned int decl_isConst (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_const; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isType - returns TRUE if node, n, is a type. -*/ - -extern "C" unsigned int decl_isType (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_type; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putType - places, exp, as the type alias to des. - TYPE des = exp ; -*/ - -extern "C" void decl_putType (decl_node des, decl_node exp) -{ - mcDebug_assert (des != NULL); - mcDebug_assert (decl_isType (des)); - des->typeF.type = exp; -} - - -/* - getType - returns the type associated with node, n. -*/ - -extern "C" decl_node decl_getType (decl_node n) -{ - switch (n->kind) - { - case decl_new: - case decl_dispose: - return NULL; - break; - - case decl_length: - return cardinalN; - break; - - case decl_inc: - case decl_dec: - case decl_incl: - case decl_excl: - return NULL; - break; - - case decl_nil: - return addressN; - break; - - case decl_true: - case decl_false: - return booleanN; - break; - - case decl_address: - return n; - break; - - case decl_loc: - return n; - break; - - case decl_byte: - return n; - break; - - case decl_word: - return n; - break; - - case decl_csizet: - return n; - break; - - case decl_cssizet: - return n; - break; - - case decl_boolean: - /* base types. */ - return n; - break; - - case decl_proc: - return n; - break; - - case decl_char: - return n; - break; - - case decl_cardinal: - return n; - break; - - case decl_longcard: - return n; - break; - - case decl_shortcard: - return n; - break; - - case decl_integer: - return n; - break; - - case decl_longint: - return n; - break; - - case decl_shortint: - return n; - break; - - case decl_real: - return n; - break; - - case decl_longreal: - return n; - break; - - case decl_shortreal: - return n; - break; - - case decl_bitset: - return n; - break; - - case decl_ztype: - return n; - break; - - case decl_rtype: - return n; - break; - - case decl_complex: - return n; - break; - - case decl_longcomplex: - return n; - break; - - case decl_shortcomplex: - return n; - break; - - case decl_type: - /* language features and compound type attributes. */ - return n->typeF.type; - break; - - case decl_record: - return n; - break; - - case decl_varient: - return n; - break; - - case decl_var: - return n->varF.type; - break; - - case decl_enumeration: - return n; - break; - - case decl_subrange: - return n->subrangeF.type; - break; - - case decl_array: - return n->arrayF.type; - break; - - case decl_string: - return charN; - break; - - case decl_const: - return n->constF.type; - break; - - case decl_literal: - return n->literalF.type; - break; - - case decl_varparam: - return n->varparamF.type; - break; - - case decl_param: - return n->paramF.type; - break; - - case decl_optarg: - return n->optargF.type; - break; - - case decl_pointer: - return n->pointerF.type; - break; - - case decl_recordfield: - return n->recordfieldF.type; - break; - - case decl_varientfield: - return n; - break; - - case decl_enumerationfield: - return n->enumerationfieldF.type; - break; - - case decl_set: - return n->setF.type; - break; - - case decl_proctype: - return n->proctypeF.returnType; - break; - - case decl_subscript: - return n->subscriptF.type; - break; - - case decl_procedure: - /* blocks. */ - return n->procedureF.returnType; - break; - - case decl_throw: - return NULL; - break; - - case decl_unreachable: - return NULL; - break; - - case decl_def: - case decl_imp: - case decl_module: - case decl_loop: - case decl_while: - case decl_for: - case decl_repeat: - case decl_if: - case decl_elsif: - case decl_assignment: - /* statements. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - - case decl_cmplx: - case decl_cast: - case decl_val: - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - /* expressions. */ - return n->binaryF.resultType; - break; - - case decl_in: - return booleanN; - break; - - case decl_max: - case decl_min: - case decl_re: - case decl_im: - case decl_abs: - case decl_constexp: - case decl_deref: - case decl_neg: - case decl_adr: - case decl_size: - case decl_tsize: - return n->unaryF.resultType; - break; - - case decl_and: - case decl_or: - case decl_not: - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - return booleanN; - break; - - case decl_trunc: - return integerN; - break; - - case decl_float: - return realN; - break; - - case decl_high: - return cardinalN; - break; - - case decl_ord: - return cardinalN; - break; - - case decl_chr: - return charN; - break; - - case decl_cap: - return charN; - break; - - case decl_arrayref: - return n->arrayrefF.resultType; - break; - - case decl_componentref: - return n->componentrefF.resultType; - break; - - case decl_pointerref: - return n->pointerrefF.resultType; - break; - - case decl_funccall: - return n->funccallF.type; - break; - - case decl_setvalue: - return n->setvalueF.type; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - M2RTS_HALT (-1); - __builtin_unreachable (); - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - skipType - skips over type aliases. -*/ - -extern "C" decl_node decl_skipType (decl_node n) -{ - while ((n != NULL) && (decl_isType (n))) - { - if ((decl_getType (n)) == NULL) - { - /* this will occur if, n, is an opaque type. */ - return n; - } - n = decl_getType (n); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putTypeHidden - marks type, des, as being a hidden type. - TYPE des ; -*/ - -extern "C" void decl_putTypeHidden (decl_node des) -{ - decl_node s; - - mcDebug_assert (des != NULL); - mcDebug_assert (decl_isType (des)); - des->typeF.isHidden = TRUE; - s = decl_getScope (des); - mcDebug_assert (decl_isDef (s)); - s->defF.hasHidden = TRUE; -} - - -/* - isTypeHidden - returns TRUE if type, n, is hidden. -*/ - -extern "C" unsigned int decl_isTypeHidden (decl_node n) -{ - mcDebug_assert (n != NULL); - mcDebug_assert (decl_isType (n)); - return n->typeF.isHidden; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - hasHidden - returns TRUE if module, n, has a hidden type. -*/ - -extern "C" unsigned int decl_hasHidden (decl_node n) -{ - mcDebug_assert (decl_isDef (n)); - return n->defF.hasHidden; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isVar - returns TRUE if node, n, is a type. -*/ - -extern "C" unsigned int decl_isVar (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_var; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isTemporary - returns TRUE if node, n, is a variable and temporary. -*/ - -extern "C" unsigned int decl_isTemporary (decl_node n) -{ - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isExported - returns TRUE if symbol, n, is exported from - the definition module. -*/ - -extern "C" unsigned int decl_isExported (decl_node n) -{ - decl_node s; - - s = decl_getScope (n); - if (s != NULL) - { - switch (s->kind) - { - case decl_def: - return Indexing_IsIndiceInIndex (s->defF.exported, reinterpret_cast (n)); - break; - - - default: - return FALSE; - break; - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getDeclScope - returns the node representing the - current declaration scope. -*/ - -extern "C" decl_node decl_getDeclScope (void) -{ - unsigned int i; - - i = Indexing_HighIndice (scopeStack); - return static_cast (Indexing_GetIndice (scopeStack, i)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getScope - returns the scope associated with node, n. -*/ - -extern "C" decl_node decl_getScope (decl_node n) -{ - switch (n->kind) - { - case decl_stmtseq: - case decl_exit: - case decl_return: - case decl_comment: - case decl_identlist: - case decl_setvalue: - case decl_halt: - case decl_new: - case decl_dispose: - case decl_length: - case decl_inc: - case decl_dec: - case decl_incl: - case decl_excl: - case decl_nil: - case decl_true: - case decl_false: - return NULL; - break; - - case decl_address: - case decl_loc: - case decl_byte: - case decl_word: - case decl_csizet: - case decl_cssizet: - return systemN; - break; - - case decl_boolean: - case decl_proc: - case decl_char: - case decl_cardinal: - case decl_longcard: - case decl_shortcard: - case decl_integer: - case decl_longint: - case decl_shortint: - case decl_real: - case decl_longreal: - case decl_shortreal: - case decl_bitset: - case decl_ztype: - case decl_rtype: - case decl_complex: - case decl_longcomplex: - case decl_shortcomplex: - /* base types. */ - return NULL; - break; - - case decl_type: - /* language features and compound type attributes. */ - return n->typeF.scope; - break; - - case decl_record: - return n->recordF.scope; - break; - - case decl_varient: - return n->varientF.scope; - break; - - case decl_var: - return n->varF.scope; - break; - - case decl_enumeration: - return n->enumerationF.scope; - break; - - case decl_subrange: - return n->subrangeF.scope; - break; - - case decl_array: - return n->arrayF.scope; - break; - - case decl_string: - return NULL; - break; - - case decl_const: - return n->constF.scope; - break; - - case decl_literal: - return NULL; - break; - - case decl_varparam: - return n->varparamF.scope; - break; - - case decl_param: - return n->paramF.scope; - break; - - case decl_optarg: - return n->optargF.scope; - break; - - case decl_pointer: - return n->pointerF.scope; - break; - - case decl_recordfield: - return n->recordfieldF.scope; - break; - - case decl_varientfield: - return n->varientfieldF.scope; - break; - - case decl_enumerationfield: - return n->enumerationfieldF.scope; - break; - - case decl_set: - return n->setF.scope; - break; - - case decl_proctype: - return n->proctypeF.scope; - break; - - case decl_subscript: - return NULL; - break; - - case decl_procedure: - /* blocks. */ - return n->procedureF.scope; - break; - - case decl_def: - case decl_imp: - case decl_module: - case decl_case: - case decl_loop: - case decl_while: - case decl_for: - case decl_repeat: - case decl_if: - case decl_elsif: - case decl_assignment: - /* statements. */ - return NULL; - break; - - case decl_componentref: - case decl_pointerref: - case decl_arrayref: - case decl_chr: - case decl_cap: - case decl_ord: - case decl_float: - case decl_trunc: - case decl_high: - case decl_cast: - case decl_val: - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - case decl_in: - /* expressions. */ - return NULL; - break; - - case decl_neg: - return NULL; - break; - - case decl_lsl: - case decl_lsr: - case decl_lor: - case decl_land: - case decl_lnot: - case decl_lxor: - case decl_and: - case decl_or: - case decl_not: - case decl_constexp: - case decl_deref: - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - return NULL; - break; - - case decl_adr: - case decl_size: - case decl_tsize: - case decl_throw: - return systemN; - break; - - case decl_unreachable: - case decl_cmplx: - case decl_re: - case decl_im: - case decl_min: - case decl_max: - return NULL; - break; - - case decl_vardecl: - return n->vardeclF.scope; - break; - - case decl_funccall: - return NULL; - break; - - case decl_explist: - return NULL; - break; - - case decl_caselabellist: - return NULL; - break; - - case decl_caselist: - return NULL; - break; - - case decl_range: - return NULL; - break; - - case decl_varargs: - return n->varargsF.scope; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLiteral - returns TRUE if, n, is a literal. -*/ - -extern "C" unsigned int decl_isLiteral (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_literal; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isConstSet - returns TRUE if, n, is a constant set. -*/ - -extern "C" unsigned int decl_isConstSet (decl_node n) -{ - mcDebug_assert (n != NULL); - if ((decl_isLiteral (n)) || (decl_isConst (n))) - { - return decl_isSet (decl_skipType (decl_getType (n))); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isEnumerationField - returns TRUE if, n, is an enumeration field. -*/ - -extern "C" unsigned int decl_isEnumerationField (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_enumerationfield; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isEnumeration - returns TRUE if node, n, is an enumeration type. -*/ - -extern "C" unsigned int decl_isEnumeration (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_enumeration; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isUnbounded - returns TRUE if, n, is an unbounded array. -*/ - -extern "C" unsigned int decl_isUnbounded (decl_node n) -{ - mcDebug_assert (n != NULL); - return (n->kind == decl_array) && n->arrayF.isUnbounded; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isParameter - returns TRUE if, n, is a parameter. -*/ - -extern "C" unsigned int decl_isParameter (decl_node n) -{ - mcDebug_assert (n != NULL); - return (n->kind == decl_param) || (n->kind == decl_varparam); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isVarParam - returns TRUE if, n, is a var parameter. -*/ - -extern "C" unsigned int decl_isVarParam (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_varparam; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isParam - returns TRUE if, n, is a non var parameter. -*/ - -extern "C" unsigned int decl_isParam (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_param; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isNonVarParam - is an alias to isParam. -*/ - -extern "C" unsigned int decl_isNonVarParam (decl_node n) -{ - return decl_isParam (n); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addOptParameter - returns an optarg which has been created and added to - procedure node, proc. It has a name, id, and, type, - and an initial value, init. -*/ - -extern "C" decl_node decl_addOptParameter (decl_node proc, nameKey_Name id, decl_node type, decl_node init) -{ - decl_node p; - decl_node l; - - mcDebug_assert (decl_isProcedure (proc)); - l = decl_makeIdentList (); - mcDebug_assert (decl_putIdent (l, id)); - checkMakeVariables (proc, l, type, FALSE, TRUE); - if (! proc->procedureF.checking) - { - p = makeOptParameter (l, type, init); - decl_addParameter (proc, p); - } - return p; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isOptarg - returns TRUE if, n, is an optarg. -*/ - -extern "C" unsigned int decl_isOptarg (decl_node n) -{ - return n->kind == decl_optarg; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isRecord - returns TRUE if, n, is a record. -*/ - -extern "C" unsigned int decl_isRecord (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_record; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isRecordField - returns TRUE if, n, is a record field. -*/ - -extern "C" unsigned int decl_isRecordField (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_recordfield; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isVarientField - returns TRUE if, n, is a varient field. -*/ - -extern "C" unsigned int decl_isVarientField (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_varientfield; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isArray - returns TRUE if, n, is an array. -*/ - -extern "C" unsigned int decl_isArray (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_array; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isProcType - returns TRUE if, n, is a procedure type. -*/ - -extern "C" unsigned int decl_isProcType (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_proctype; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isPointer - returns TRUE if, n, is a pointer. -*/ - -extern "C" unsigned int decl_isPointer (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_pointer; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isProcedure - returns TRUE if, n, is a procedure. -*/ - -extern "C" unsigned int decl_isProcedure (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_procedure; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isVarient - returns TRUE if, n, is a varient record. -*/ - -extern "C" unsigned int decl_isVarient (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_varient; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isSet - returns TRUE if, n, is a set type. -*/ - -extern "C" unsigned int decl_isSet (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_set; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isSubrange - returns TRUE if, n, is a subrange type. -*/ - -extern "C" unsigned int decl_isSubrange (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_subrange; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isZtype - returns TRUE if, n, is the Z type. -*/ - -extern "C" unsigned int decl_isZtype (decl_node n) -{ - return n == ztypeN; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isRtype - returns TRUE if, n, is the R type. -*/ - -extern "C" unsigned int decl_isRtype (decl_node n) -{ - return n == rtypeN; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeConst - create, initialise and return a const node. -*/ - -extern "C" decl_node decl_makeConst (nameKey_Name n) -{ - decl_node d; - - d = newNode (decl_const); - d->constF.name = n; - d->constF.type = NULL; - d->constF.scope = decl_getDeclScope (); - d->constF.value = NULL; - return addToScope (d); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putConst - places value, v, into node, n. -*/ - -extern "C" void decl_putConst (decl_node n, decl_node v) -{ - mcDebug_assert (decl_isConst (n)); - n->constF.value = v; -} - - -/* - makeType - create, initialise and return a type node. -*/ - -extern "C" decl_node decl_makeType (nameKey_Name n) -{ - decl_node d; - - d = newNode (decl_type); - d->typeF.name = n; - d->typeF.type = NULL; - d->typeF.scope = decl_getDeclScope (); - d->typeF.isHidden = FALSE; - d->typeF.isInternal = FALSE; - return addToScope (d); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeTypeImp - lookup a type in the definition module - and return it. Otherwise create a new type. -*/ - -extern "C" decl_node decl_makeTypeImp (nameKey_Name n) -{ - decl_node d; - - d = decl_lookupSym (n); - if (d != NULL) - { - d->typeF.isHidden = FALSE; - return addToScope (d); - } - else - { - d = newNode (decl_type); - d->typeF.name = n; - d->typeF.type = NULL; - d->typeF.scope = decl_getDeclScope (); - d->typeF.isHidden = FALSE; - return addToScope (d); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeVar - create, initialise and return a var node. -*/ - -extern "C" decl_node decl_makeVar (nameKey_Name n) -{ - decl_node d; - - d = newNode (decl_var); - d->varF.name = n; - d->varF.type = NULL; - d->varF.decl = NULL; - d->varF.scope = decl_getDeclScope (); - d->varF.isInitialised = FALSE; - d->varF.isParameter = FALSE; - d->varF.isVarParameter = FALSE; - initCname (&d->varF.cname); - return addToScope (d); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putVar - places, type, as the type for var. -*/ - -extern "C" void decl_putVar (decl_node var, decl_node type, decl_node decl) -{ - mcDebug_assert (var != NULL); - mcDebug_assert (decl_isVar (var)); - var->varF.type = type; - var->varF.decl = decl; -} - - -/* - makeVarDecl - create a vardecl node and create a shadow variable in the - current scope. -*/ - -extern "C" decl_node decl_makeVarDecl (decl_node i, decl_node type) -{ - decl_node d; - decl_node v; - unsigned int j; - unsigned int n; - - type = checkPtr (type); - d = newNode (decl_vardecl); - d->vardeclF.names = i->identlistF.names; - d->vardeclF.type = type; - d->vardeclF.scope = decl_getDeclScope (); - n = wlists_noOfItemsInList (d->vardeclF.names); - j = 1; - while (j <= n) - { - v = decl_lookupSym (wlists_getItemFromList (d->vardeclF.names, j)); - mcDebug_assert (decl_isVar (v)); - decl_putVar (v, type, d); - j += 1; - } - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeEnum - creates an enumerated type and returns the node. -*/ - -extern "C" decl_node decl_makeEnum (void) -{ - if ((currentModule != NULL) && (decl_getEnumsComplete (currentModule))) - { - return decl_getNextEnum (); - } - else - { - return doMakeEnum (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeEnumField - returns an enumeration field, named, n. -*/ - -extern "C" decl_node decl_makeEnumField (decl_node e, nameKey_Name n) -{ - if ((currentModule != NULL) && (decl_getEnumsComplete (currentModule))) - { - return decl_getNextEnum (); - } - else - { - return doMakeEnumField (e, n); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeSubrange - returns a subrange node, built from range: low..high. -*/ - -extern "C" decl_node decl_makeSubrange (decl_node low, decl_node high) -{ - decl_node n; - - n = newNode (decl_subrange); - n->subrangeF.low = low; - n->subrangeF.high = high; - n->subrangeF.type = NULL; - n->subrangeF.scope = decl_getDeclScope (); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putSubrangeType - assigns, type, to the subrange type, sub. -*/ - -extern "C" void decl_putSubrangeType (decl_node sub, decl_node type) -{ - mcDebug_assert (decl_isSubrange (sub)); - sub->subrangeF.type = type; -} - - -/* - makePointer - returns a pointer of, type, node. -*/ - -extern "C" decl_node decl_makePointer (decl_node type) -{ - decl_node n; - - n = newNode (decl_pointer); - n->pointerF.type = type; - n->pointerF.scope = decl_getDeclScope (); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeSet - returns a set of, type, node. -*/ - -extern "C" decl_node decl_makeSet (decl_node type) -{ - decl_node n; - - n = newNode (decl_set); - n->setF.type = type; - n->setF.scope = decl_getDeclScope (); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeArray - returns a node representing ARRAY subr OF type. -*/ - -extern "C" decl_node decl_makeArray (decl_node subr, decl_node type) -{ - decl_node n; - decl_node s; - - s = decl_skipType (subr); - mcDebug_assert (((decl_isSubrange (s)) || (isOrdinal (s))) || (decl_isEnumeration (s))); - n = newNode (decl_array); - n->arrayF.subr = subr; - n->arrayF.type = type; - n->arrayF.scope = decl_getDeclScope (); - n->arrayF.isUnbounded = FALSE; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putUnbounded - sets array, n, as unbounded. -*/ - -extern "C" void decl_putUnbounded (decl_node n) -{ - mcDebug_assert (n->kind == decl_array); - n->arrayF.isUnbounded = TRUE; -} - - -/* - makeRecord - creates and returns a record node. -*/ - -extern "C" decl_node decl_makeRecord (void) -{ - decl_node n; - - n = newNode (decl_record); - n->recordF.localSymbols = symbolKey_initTree (); - n->recordF.listOfSons = Indexing_InitIndex (1); - n->recordF.scope = decl_getDeclScope (); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeVarient - creates a new symbol, a varient symbol for record or varient field - symbol, r. -*/ - -extern "C" decl_node decl_makeVarient (decl_node r) -{ - decl_node n; - - n = newNode (decl_varient); - n->varientF.listOfSons = Indexing_InitIndex (1); - /* if so use this n^.varientF.parent := r */ - if (decl_isRecord (r)) - { - n->varientF.varient = NULL; - } - else - { - n->varientF.varient = r; - } - n->varientF.tag = NULL; - n->varientF.scope = decl_getDeclScope (); - switch (r->kind) - { - case decl_record: - /* now add, n, to the record/varient, r, field list */ - Indexing_IncludeIndiceIntoIndex (r->recordF.listOfSons, reinterpret_cast (n)); - break; - - case decl_varientfield: - Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast (n)); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addFieldsToRecord - adds fields, i, of type, t, into a record, r. - It returns, r. -*/ - -extern "C" decl_node decl_addFieldsToRecord (decl_node r, decl_node v, decl_node i, decl_node t) -{ - decl_node p; - decl_node fj; - unsigned int j; - unsigned int n; - nameKey_Name fn; - - if (decl_isRecord (r)) - { - p = r; - v = NULL; - } - else - { - p = getRecord (getParent (r)); - mcDebug_assert (decl_isVarientField (r)); - mcDebug_assert (decl_isVarient (v)); - putFieldVarient (r, v); - } - n = wlists_noOfItemsInList (i->identlistF.names); - j = 1; - while (j <= n) - { - fn = static_cast (wlists_getItemFromList (i->identlistF.names, j)); - fj = static_cast (symbolKey_getSymKey (p->recordF.localSymbols, n)); - if (fj == NULL) - { - fj = putFieldRecord (r, fn, t, v); - } - else - { - mcMetaError_metaErrors2 ((const char *) "record field {%1ad} has already been declared inside a {%2Dd} {%2a}", 67, (const char *) "attempting to declare a duplicate record field", 46, (const unsigned char *) &fj, (sizeof (fj)-1), (const unsigned char *) &p, (sizeof (p)-1)); - } - j += 1; - } - return r; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - buildVarientSelector - builds a field of name, tag, of, type onto: - record or varient field, r. - varient, v. -*/ - -extern "C" void decl_buildVarientSelector (decl_node r, decl_node v, nameKey_Name tag, decl_node type) -{ - decl_node f; - - mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r))); - if ((decl_isRecord (r)) || (decl_isVarientField (r))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((type == NULL) && (tag == nameKey_NulName)) - { - mcMetaError_metaError1 ((const char *) "expecting a tag field in the declaration of a varient record {%1Ua}", 67, (const unsigned char *) &r, (sizeof (r)-1)); - } - else if (type == NULL) - { - /* avoid dangling else. */ - f = decl_lookupSym (tag); - putVarientTag (v, f); - } - else - { - /* avoid dangling else. */ - f = putFieldRecord (r, tag, type, v); - mcDebug_assert (decl_isRecordField (f)); - f->recordfieldF.tag = TRUE; - putVarientTag (v, f); - } - } -} - - -/* - buildVarientFieldRecord - builds a varient field into a varient symbol, v. - The varient field is returned. -*/ - -extern "C" decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p) -{ - decl_node f; - - mcDebug_assert (decl_isVarient (v)); - f = makeVarientField (v, p); - mcDebug_assert (decl_isVarientField (f)); - putFieldVarient (f, v); - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getSymName - returns the name of symbol, n. -*/ - -extern "C" nameKey_Name decl_getSymName (decl_node n) -{ - switch (n->kind) - { - case decl_new: - return nameKey_makeKey ((const char *) "NEW", 3); - break; - - case decl_dispose: - return nameKey_makeKey ((const char *) "DISPOSE", 7); - break; - - case decl_length: - return nameKey_makeKey ((const char *) "LENGTH", 6); - break; - - case decl_inc: - return nameKey_makeKey ((const char *) "INC", 3); - break; - - case decl_dec: - return nameKey_makeKey ((const char *) "DEC", 3); - break; - - case decl_incl: - return nameKey_makeKey ((const char *) "INCL", 4); - break; - - case decl_excl: - return nameKey_makeKey ((const char *) "EXCL", 4); - break; - - case decl_nil: - return nameKey_makeKey ((const char *) "NIL", 3); - break; - - case decl_true: - return nameKey_makeKey ((const char *) "TRUE", 4); - break; - - case decl_false: - return nameKey_makeKey ((const char *) "FALSE", 5); - break; - - case decl_address: - return nameKey_makeKey ((const char *) "ADDRESS", 7); - break; - - case decl_loc: - return nameKey_makeKey ((const char *) "LOC", 3); - break; - - case decl_byte: - return nameKey_makeKey ((const char *) "BYTE", 4); - break; - - case decl_word: - return nameKey_makeKey ((const char *) "WORD", 4); - break; - - case decl_csizet: - return nameKey_makeKey ((const char *) "CSIZE_T", 7); - break; - - case decl_cssizet: - return nameKey_makeKey ((const char *) "CSSIZE_T", 8); - break; - - case decl_boolean: - /* base types. */ - return nameKey_makeKey ((const char *) "BOOLEAN", 7); - break; - - case decl_proc: - return nameKey_makeKey ((const char *) "PROC", 4); - break; - - case decl_char: - return nameKey_makeKey ((const char *) "CHAR", 4); - break; - - case decl_cardinal: - return nameKey_makeKey ((const char *) "CARDINAL", 8); - break; - - case decl_longcard: - return nameKey_makeKey ((const char *) "LONGCARD", 8); - break; - - case decl_shortcard: - return nameKey_makeKey ((const char *) "SHORTCARD", 9); - break; - - case decl_integer: - return nameKey_makeKey ((const char *) "INTEGER", 7); - break; - - case decl_longint: - return nameKey_makeKey ((const char *) "LONGINT", 7); - break; - - case decl_shortint: - return nameKey_makeKey ((const char *) "SHORTINT", 8); - break; - - case decl_real: - return nameKey_makeKey ((const char *) "REAL", 4); - break; - - case decl_longreal: - return nameKey_makeKey ((const char *) "LONGREAL", 8); - break; - - case decl_shortreal: - return nameKey_makeKey ((const char *) "SHORTREAL", 9); - break; - - case decl_bitset: - return nameKey_makeKey ((const char *) "BITSET", 6); - break; - - case decl_ztype: - return nameKey_makeKey ((const char *) "_ZTYPE", 6); - break; - - case decl_rtype: - return nameKey_makeKey ((const char *) "_RTYPE", 6); - break; - - case decl_complex: - return nameKey_makeKey ((const char *) "COMPLEX", 7); - break; - - case decl_longcomplex: - return nameKey_makeKey ((const char *) "LONGCOMPLEX", 11); - break; - - case decl_shortcomplex: - return nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12); - break; - - case decl_type: - /* language features and compound type attributes. */ - return n->typeF.name; - break; - - case decl_record: - return nameKey_NulName; - break; - - case decl_varient: - return nameKey_NulName; - break; - - case decl_var: - return n->varF.name; - break; - - case decl_enumeration: - return nameKey_NulName; - break; - - case decl_subrange: - return nameKey_NulName; - break; - - case decl_pointer: - return nameKey_NulName; - break; - - case decl_array: - return nameKey_NulName; - break; - - case decl_string: - return n->stringF.name; - break; - - case decl_const: - return n->constF.name; - break; - - case decl_literal: - return n->literalF.name; - break; - - case decl_varparam: - return nameKey_NulName; - break; - - case decl_param: - return nameKey_NulName; - break; - - case decl_optarg: - return nameKey_NulName; - break; - - case decl_recordfield: - return n->recordfieldF.name; - break; - - case decl_varientfield: - return n->varientfieldF.name; - break; - - case decl_enumerationfield: - return n->enumerationfieldF.name; - break; - - case decl_set: - return nameKey_NulName; - break; - - case decl_proctype: - return nameKey_NulName; - break; - - case decl_subscript: - return nameKey_NulName; - break; - - case decl_procedure: - /* blocks. */ - return n->procedureF.name; - break; - - case decl_def: - return n->defF.name; - break; - - case decl_imp: - return n->impF.name; - break; - - case decl_module: - return n->moduleF.name; - break; - - case decl_loop: - case decl_while: - case decl_for: - case decl_repeat: - case decl_if: - case decl_elsif: - case decl_assignment: - /* statements. */ - return nameKey_NulName; - break; - - case decl_constexp: - case decl_deref: - case decl_arrayref: - case decl_componentref: - case decl_cast: - case decl_val: - case decl_plus: - case decl_sub: - case decl_div: - case decl_mod: - case decl_mult: - case decl_divide: - case decl_in: - case decl_neg: - case decl_equal: - case decl_notequal: - case decl_less: - case decl_greater: - case decl_greequal: - case decl_lessequal: - /* expressions. */ - return nameKey_NulName; - break; - - case decl_adr: - return nameKey_makeKey ((const char *) "ADR", 3); - break; - - case decl_size: - return nameKey_makeKey ((const char *) "SIZE", 4); - break; - - case decl_tsize: - return nameKey_makeKey ((const char *) "TSIZE", 5); - break; - - case decl_chr: - return nameKey_makeKey ((const char *) "CHR", 3); - break; - - case decl_abs: - return nameKey_makeKey ((const char *) "ABS", 3); - break; - - case decl_ord: - return nameKey_makeKey ((const char *) "ORD", 3); - break; - - case decl_float: - return nameKey_makeKey ((const char *) "FLOAT", 5); - break; - - case decl_trunc: - return nameKey_makeKey ((const char *) "TRUNC", 5); - break; - - case decl_high: - return nameKey_makeKey ((const char *) "HIGH", 4); - break; - - case decl_throw: - return nameKey_makeKey ((const char *) "THROW", 5); - break; - - case decl_unreachable: - return nameKey_makeKey ((const char *) "builtin_unreachable", 19); - break; - - case decl_cmplx: - return nameKey_makeKey ((const char *) "CMPLX", 5); - break; - - case decl_re: - return nameKey_makeKey ((const char *) "RE", 2); - break; - - case decl_im: - return nameKey_makeKey ((const char *) "IM", 2); - break; - - case decl_max: - return nameKey_makeKey ((const char *) "MAX", 3); - break; - - case decl_min: - return nameKey_makeKey ((const char *) "MIN", 3); - break; - - case decl_funccall: - return nameKey_NulName; - break; - - case decl_identlist: - return nameKey_NulName; - break; - - - default: - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - import - attempts to add node, n, into the scope of module, m. - It might fail due to a name clash in which case the - previous named symbol is returned. On success, n, - is returned. -*/ - -extern "C" decl_node decl_import (decl_node m, decl_node n) -{ - nameKey_Name name; - decl_node r; - - mcDebug_assert (((decl_isDef (m)) || (decl_isModule (m))) || (decl_isImp (m))); - name = decl_getSymName (n); - r = decl_lookupInScope (m, name); - if (r == NULL) - { - switch (m->kind) - { - case decl_def: - symbolKey_putSymKey (m->defF.decls.symbols, name, reinterpret_cast (n)); - break; - - case decl_imp: - symbolKey_putSymKey (m->impF.decls.symbols, name, reinterpret_cast (n)); - break; - - case decl_module: - symbolKey_putSymKey (m->moduleF.decls.symbols, name, reinterpret_cast (n)); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - importEnumFields (m, n); - return n; - } - return r; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - lookupExported - attempts to lookup a node named, i, from definition - module, n. The node is returned if found. - NIL is returned if not found. -*/ - -extern "C" decl_node decl_lookupExported (decl_node n, nameKey_Name i) -{ - decl_node r; - - mcDebug_assert (decl_isDef (n)); - r = static_cast (symbolKey_getSymKey (n->defF.decls.symbols, i)); - if ((r != NULL) && (decl_isExported (r))) - { - return r; - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - lookupSym - returns the symbol named, n, from the scope stack. -*/ - -extern "C" decl_node decl_lookupSym (nameKey_Name n) -{ - decl_node s; - decl_node m; - unsigned int l; - unsigned int h; - - l = Indexing_LowIndice (scopeStack); - h = Indexing_HighIndice (scopeStack); - while (h >= l) - { - s = static_cast (Indexing_GetIndice (scopeStack, h)); - m = decl_lookupInScope (s, n); - if (debugScopes && (m == NULL)) - { - out3 ((const char *) " [%d] search for symbol name %s in scope %s\\n", 45, h, n, s); - } - if (m != NULL) - { - if (debugScopes) - { - out3 ((const char *) " [%d] search for symbol name %s in scope %s (found)\\n", 53, h, n, s); - } - return m; - } - h -= 1; - } - return lookupBase (n); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addImportedModule - add module, i, to be imported by, m. - If scoped then module, i, is added to the - module, m, scope. -*/ - -extern "C" void decl_addImportedModule (decl_node m, decl_node i, unsigned int scoped) -{ - mcDebug_assert ((decl_isDef (i)) || (decl_isModule (i))); - if (decl_isDef (m)) - { - Indexing_IncludeIndiceIntoIndex (m->defF.importedModules, reinterpret_cast (i)); - } - else if (decl_isImp (m)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex (m->impF.importedModules, reinterpret_cast (i)); - } - else if (decl_isModule (m)) - { - /* avoid dangling else. */ - Indexing_IncludeIndiceIntoIndex (m->moduleF.importedModules, reinterpret_cast (i)); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - if (scoped) - { - addModuleToScope (m, i); - } -} - - -/* - setSource - sets the source filename for module, n, to s. -*/ - -extern "C" void decl_setSource (decl_node n, nameKey_Name s) -{ - switch (n->kind) - { - case decl_def: - n->defF.source = s; - break; - - case decl_module: - n->moduleF.source = s; - break; - - case decl_imp: - n->impF.source = s; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - getSource - returns the source filename for module, n. -*/ - -extern "C" nameKey_Name decl_getSource (decl_node n) -{ - switch (n->kind) - { - case decl_def: - return n->defF.source; - break; - - case decl_module: - return n->moduleF.source; - break; - - case decl_imp: - return n->impF.source; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getMainModule - returns the main module node. -*/ - -extern "C" decl_node decl_getMainModule (void) -{ - return mainModule; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getCurrentModule - returns the current module being compiled. -*/ - -extern "C" decl_node decl_getCurrentModule (void) -{ - return currentModule; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - foreachDefModuleDo - foreach definition node, n, in the module universe, - call p (n). -*/ - -extern "C" void decl_foreachDefModuleDo (symbolKey_performOperation p) -{ - Indexing_ForeachIndiceInIndexDo (defUniverseI, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) p.proc}); -} - - -/* - foreachModModuleDo - foreach implementation or module node, n, in the module universe, - call p (n). -*/ - -extern "C" void decl_foreachModModuleDo (symbolKey_performOperation p) -{ - Indexing_ForeachIndiceInIndexDo (modUniverseI, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) p.proc}); -} - - -/* - enterScope - pushes symbol, n, to the scope stack. -*/ - -extern "C" void decl_enterScope (decl_node n) -{ - if (Indexing_IsIndiceInIndex (scopeStack, reinterpret_cast (n))) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - Indexing_IncludeIndiceIntoIndex (scopeStack, reinterpret_cast (n)); - } - if (debugScopes) - { - libc_printf ((const char *) "enter scope\\n", 13); - dumpScopes (); - } -} - - -/* - leaveScope - removes the top level scope. -*/ - -extern "C" void decl_leaveScope (void) -{ - unsigned int i; - decl_node n; - - i = Indexing_HighIndice (scopeStack); - n = static_cast (Indexing_GetIndice (scopeStack, i)); - Indexing_RemoveIndiceFromIndex (scopeStack, reinterpret_cast (n)); - if (debugScopes) - { - libc_printf ((const char *) "leave scope\\n", 13); - dumpScopes (); - } -} - - -/* - makeProcedure - create, initialise and return a procedure node. -*/ - -extern "C" decl_node decl_makeProcedure (nameKey_Name n) -{ - decl_node d; - - d = decl_lookupSym (n); - if (d == NULL) - { - d = newNode (decl_procedure); - d->procedureF.name = n; - initDecls (&d->procedureF.decls); - d->procedureF.scope = decl_getDeclScope (); - d->procedureF.parameters = Indexing_InitIndex (1); - d->procedureF.isForC = isDefForCNode (decl_getDeclScope ()); - d->procedureF.built = FALSE; - d->procedureF.returnopt = FALSE; - d->procedureF.optarg_ = NULL; - d->procedureF.noreturnused = FALSE; - d->procedureF.noreturn = FALSE; - d->procedureF.vararg = FALSE; - d->procedureF.checking = FALSE; - d->procedureF.paramcount = 0; - d->procedureF.returnType = NULL; - d->procedureF.beginStatements = NULL; - initCname (&d->procedureF.cname); - d->procedureF.defComment = NULL; - d->procedureF.modComment = NULL; - } - return addProcedureToScope (d, n); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putCommentDefProcedure - remembers the procedure comment (if it exists) as a - definition module procedure heading. NIL is placed - if there is no procedure comment available. -*/ - -extern "C" void decl_putCommentDefProcedure (decl_node n) -{ - mcDebug_assert (decl_isProcedure (n)); - if (mcComment_isProcedureComment (mcLexBuf_lastcomment)) - { - n->procedureF.defComment = mcLexBuf_lastcomment; - } -} - - -/* - putCommentModProcedure - remembers the procedure comment (if it exists) as an - implementation/program module procedure heading. NIL is placed - if there is no procedure comment available. -*/ - -extern "C" void decl_putCommentModProcedure (decl_node n) -{ - mcDebug_assert (decl_isProcedure (n)); - if (mcComment_isProcedureComment (mcLexBuf_lastcomment)) - { - n->procedureF.modComment = mcLexBuf_lastcomment; - } -} - - -/* - makeProcType - returns a proctype node. -*/ - -extern "C" decl_node decl_makeProcType (void) -{ - decl_node d; - - d = newNode (decl_proctype); - d->proctypeF.scope = decl_getDeclScope (); - d->proctypeF.parameters = Indexing_InitIndex (1); - d->proctypeF.returnopt = FALSE; - d->proctypeF.optarg_ = NULL; - d->proctypeF.vararg = FALSE; - d->proctypeF.returnType = NULL; - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putReturnType - sets the return type of procedure or proctype, proc, to, type. -*/ - -extern "C" void decl_putReturnType (decl_node proc, decl_node type) -{ - mcDebug_assert ((decl_isProcedure (proc)) || (decl_isProcType (proc))); - if (decl_isProcedure (proc)) - { - proc->procedureF.returnType = type; - } - else - { - proc->proctypeF.returnType = type; - } -} - - -/* - putOptReturn - sets, proctype or procedure, proc, to have an optional return type. -*/ - -extern "C" void decl_putOptReturn (decl_node proc) -{ - mcDebug_assert ((decl_isProcedure (proc)) || (decl_isProcType (proc))); - if (decl_isProcedure (proc)) - { - proc->procedureF.returnopt = TRUE; - } - else - { - proc->proctypeF.returnopt = TRUE; - } -} - - -/* - makeVarParameter - returns a var parameter node with, name: type. -*/ - -extern "C" decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused) -{ - decl_node d; - - mcDebug_assert ((l == NULL) || (isIdentList (l))); - d = newNode (decl_varparam); - d->varparamF.namelist = l; - d->varparamF.type = type; - d->varparamF.scope = proc; - d->varparamF.isUnbounded = FALSE; - d->varparamF.isForC = isDefForCNode (proc); - d->varparamF.isUsed = isused; - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeNonVarParameter - returns a non var parameter node with, name: type. -*/ - -extern "C" decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused) -{ - decl_node d; - - mcDebug_assert ((l == NULL) || (isIdentList (l))); - d = newNode (decl_param); - d->paramF.namelist = l; - d->paramF.type = type; - d->paramF.scope = proc; - d->paramF.isUnbounded = FALSE; - d->paramF.isForC = isDefForCNode (proc); - d->paramF.isUsed = isused; - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - paramEnter - reset the parameter count. -*/ - -extern "C" void decl_paramEnter (decl_node n) -{ - mcDebug_assert (decl_isProcedure (n)); - n->procedureF.paramcount = 0; -} - - -/* - paramLeave - set paramater checking to TRUE from now onwards. -*/ - -extern "C" void decl_paramLeave (decl_node n) -{ - mcDebug_assert (decl_isProcedure (n)); - n->procedureF.checking = TRUE; - if ((decl_isImp (currentModule)) || (decl_isModule (currentModule))) - { - n->procedureF.built = TRUE; - } -} - - -/* - makeIdentList - returns a node which will be used to maintain an ident list. -*/ - -extern "C" decl_node decl_makeIdentList (void) -{ - decl_node n; - - n = newNode (decl_identlist); - n->identlistF.names = wlists_initList (); - n->identlistF.cnamed = FALSE; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putIdent - places ident, i, into identlist, n. It returns TRUE if - ident, i, is unique. -*/ - -extern "C" unsigned int decl_putIdent (decl_node n, nameKey_Name i) -{ - mcDebug_assert (isIdentList (n)); - if (wlists_isItemInList (n->identlistF.names, i)) - { - return FALSE; - } - else - { - wlists_putItemIntoList (n->identlistF.names, i); - return TRUE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addVarParameters - adds the identlist, i, of, type, to be VAR parameters - in procedure, n. -*/ - -extern "C" void decl_addVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused) -{ - decl_node p; - - mcDebug_assert (isIdentList (i)); - mcDebug_assert (decl_isProcedure (n)); - checkMakeVariables (n, i, type, TRUE, isused); - if (n->procedureF.checking) - { - checkParameters (n, i, type, TRUE, isused); /* will destroy, i. */ - } - else - { - p = decl_makeVarParameter (i, type, n, isused); - Indexing_IncludeIndiceIntoIndex (n->procedureF.parameters, reinterpret_cast (p)); - } -} - - -/* - addNonVarParameters - adds the identlist, i, of, type, to be parameters - in procedure, n. -*/ - -extern "C" void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused) -{ - decl_node p; - - mcDebug_assert (isIdentList (i)); - mcDebug_assert (decl_isProcedure (n)); - checkMakeVariables (n, i, type, FALSE, isused); - if (n->procedureF.checking) - { - checkParameters (n, i, type, FALSE, isused); /* will destroy, i. */ - } - else - { - p = decl_makeNonVarParameter (i, type, n, isused); - Indexing_IncludeIndiceIntoIndex (n->procedureF.parameters, reinterpret_cast (p)); - } -} - - -/* - makeVarargs - returns a varargs node. -*/ - -extern "C" decl_node decl_makeVarargs (void) -{ - decl_node d; - - d = newNode (decl_varargs); - d->varargsF.scope = NULL; - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isVarargs - returns TRUE if, n, is a varargs node. -*/ - -extern "C" unsigned int decl_isVarargs (decl_node n) -{ - return n->kind == decl_varargs; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addParameter - adds a parameter, param, to procedure or proctype, proc. -*/ - -extern "C" void decl_addParameter (decl_node proc, decl_node param) -{ - mcDebug_assert ((((decl_isVarargs (param)) || (decl_isParam (param))) || (decl_isVarParam (param))) || (decl_isOptarg (param))); - switch (proc->kind) - { - case decl_procedure: - Indexing_IncludeIndiceIntoIndex (proc->procedureF.parameters, reinterpret_cast (param)); - if (decl_isVarargs (param)) - { - proc->procedureF.vararg = TRUE; - } - if (decl_isOptarg (param)) - { - proc->procedureF.optarg_ = param; - } - break; - - case decl_proctype: - Indexing_IncludeIndiceIntoIndex (proc->proctypeF.parameters, reinterpret_cast (param)); - if (decl_isVarargs (param)) - { - proc->proctypeF.vararg = TRUE; - } - if (decl_isOptarg (param)) - { - proc->proctypeF.optarg_ = param; - } - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - makeBinaryTok - creates and returns a boolean type node with, - l, and, r, nodes. -*/ - -extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, decl_node r) -{ - if (op == mcReserved_equaltok) - { - return makeBinary (decl_equal, l, r, booleanN); - } - else if ((op == mcReserved_hashtok) || (op == mcReserved_lessgreatertok)) - { - /* avoid dangling else. */ - return makeBinary (decl_notequal, l, r, booleanN); - } - else if (op == mcReserved_lesstok) - { - /* avoid dangling else. */ - return makeBinary (decl_less, l, r, booleanN); - } - else if (op == mcReserved_greatertok) - { - /* avoid dangling else. */ - return makeBinary (decl_greater, l, r, booleanN); - } - else if (op == mcReserved_greaterequaltok) - { - /* avoid dangling else. */ - return makeBinary (decl_greequal, l, r, booleanN); - } - else if (op == mcReserved_lessequaltok) - { - /* avoid dangling else. */ - return makeBinary (decl_lessequal, l, r, booleanN); - } - else if (op == mcReserved_andtok) - { - /* avoid dangling else. */ - return makeBinary (decl_and, l, r, booleanN); - } - else if (op == mcReserved_ortok) - { - /* avoid dangling else. */ - return makeBinary (decl_or, l, r, booleanN); - } - else if (op == mcReserved_plustok) - { - /* avoid dangling else. */ - return makeBinary (decl_plus, l, r, NULL); - } - else if (op == mcReserved_minustok) - { - /* avoid dangling else. */ - return makeBinary (decl_sub, l, r, NULL); - } - else if (op == mcReserved_divtok) - { - /* avoid dangling else. */ - return makeBinary (decl_div, l, r, NULL); - } - else if (op == mcReserved_timestok) - { - /* avoid dangling else. */ - return makeBinary (decl_mult, l, r, NULL); - } - else if (op == mcReserved_modtok) - { - /* avoid dangling else. */ - return makeBinary (decl_mod, l, r, NULL); - } - else if (op == mcReserved_intok) - { - /* avoid dangling else. */ - return makeBinary (decl_in, l, r, NULL); - } - else if (op == mcReserved_dividetok) - { - /* avoid dangling else. */ - return makeBinary (decl_divide, l, r, NULL); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); /* most likely op needs a clause as above. */ - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - makeUnaryTok - creates and returns a boolean type node with, - e, node. -*/ - -extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e) -{ - if (op == mcReserved_nottok) - { - return makeUnary (decl_not, e, booleanN); - } - else if (op == mcReserved_plustok) - { - /* avoid dangling else. */ - return makeUnary (decl_plus, e, NULL); - } - else if (op == mcReserved_minustok) - { - /* avoid dangling else. */ - return makeUnary (decl_neg, e, NULL); - } - else - { - /* avoid dangling else. */ - M2RTS_HALT (-1); /* most likely op needs a clause as above. */ - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); -} - - -/* - makeComponentRef - build a componentref node which accesses, field, - within, record, rec. -*/ - -extern "C" decl_node decl_makeComponentRef (decl_node rec, decl_node field) -{ - decl_node n; - decl_node a; - - /* - n := getLastOp (rec) ; - IF (n#NIL) AND (isDeref (n) OR isPointerRef (n)) AND - (skipType (getType (rec)) = skipType (getType (n))) - THEN - a := n^.unaryF.arg ; - n^.kind := pointerref ; - n^.pointerrefF.ptr := a ; - n^.pointerrefF.field := field ; - n^.pointerrefF.resultType := getType (field) ; - RETURN n - ELSE - RETURN doMakeComponentRef (rec, field) - END - */ - if (isDeref (rec)) - { - a = rec->unaryF.arg; - rec->kind = decl_pointerref; - rec->pointerrefF.ptr = a; - rec->pointerrefF.field = field; - rec->pointerrefF.resultType = decl_getType (field); - return rec; - } - else - { - return doMakeComponentRef (rec, field); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makePointerRef - build a pointerref node which accesses, field, - within, pointer to record, ptr. -*/ - -extern "C" decl_node decl_makePointerRef (decl_node ptr, decl_node field) -{ - decl_node n; - - n = newNode (decl_pointerref); - n->pointerrefF.ptr = ptr; - n->pointerrefF.field = field; - n->pointerrefF.resultType = decl_getType (field); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isPointerRef - returns TRUE if, n, is a pointerref node. -*/ - -extern "C" unsigned int decl_isPointerRef (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_pointerref; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeDeRef - dereferences the pointer defined by, n. -*/ - -extern "C" decl_node decl_makeDeRef (decl_node n) -{ - decl_node t; - - t = decl_skipType (decl_getType (n)); - mcDebug_assert (decl_isPointer (t)); - return makeUnary (decl_deref, n, decl_getType (t)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeArrayRef - build an arrayref node which access element, - index, in, array. array is a variable/expression/constant - which has a type array. -*/ - -extern "C" decl_node decl_makeArrayRef (decl_node array, decl_node index) -{ - decl_node n; - decl_node t; - unsigned int i; - unsigned int j; - - n = newNode (decl_arrayref); - n->arrayrefF.array = array; - n->arrayrefF.index = index; - t = array; - j = expListLen (index); - i = 1; - t = decl_skipType (decl_getType (t)); - do { - if (decl_isArray (t)) - { - t = decl_skipType (decl_getType (t)); - } - else - { - mcMetaError_metaError2 ((const char *) "cannot access {%1N} dimension of array {%2a}", 44, (const unsigned char *) &i, (sizeof (i)-1), (const unsigned char *) &t, (sizeof (t)-1)); - } - i += 1; - } while (! (i > j)); - n->arrayrefF.resultType = t; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getLastOp - return the right most non leaf node. -*/ - -extern "C" decl_node decl_getLastOp (decl_node n) -{ - return doGetLastOp (n, n); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getCardinal - returns the cardinal type node. -*/ - -extern "C" decl_node decl_getCardinal (void) -{ - return cardinalN; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeLiteralInt - creates and returns a literal node based on an integer type. -*/ - -extern "C" decl_node decl_makeLiteralInt (nameKey_Name n) -{ - decl_node m; - DynamicStrings_String s; - - m = newNode (decl_literal); - s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); - m->literalF.name = n; - if ((DynamicStrings_char (s, -1)) == 'C') - { - m->literalF.type = charN; - } - else - { - m->literalF.type = ztypeN; - } - s = DynamicStrings_KillString (s); - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeLiteralReal - creates and returns a literal node based on a real type. -*/ - -extern "C" decl_node decl_makeLiteralReal (nameKey_Name n) -{ - decl_node m; - - m = newNode (decl_literal); - m->literalF.name = n; - m->literalF.type = rtypeN; - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeString - creates and returns a node containing string, n. -*/ - -extern "C" decl_node decl_makeString (nameKey_Name n) -{ - decl_node m; - - m = newNode (decl_string); - m->stringF.name = n; - m->stringF.length = nameKey_lengthKey (n); - m->stringF.isCharCompatible = m->stringF.length <= 3; - m->stringF.cstring = toCstring (n); - m->stringF.clength = lenCstring (m->stringF.cstring); - if (m->stringF.isCharCompatible) - { - m->stringF.cchar = toCchar (n); - } - else - { - m->stringF.cchar = NULL; - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeSetValue - creates and returns a setvalue node. -*/ - -extern "C" decl_node decl_makeSetValue (void) -{ - decl_node n; - - n = newNode (decl_setvalue); - n->setvalueF.type = bitsetN; - n->setvalueF.values = Indexing_InitIndex (1); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isSetValue - returns TRUE if, n, is a setvalue node. -*/ - -extern "C" unsigned int decl_isSetValue (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_setvalue; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putSetValue - assigns the type, t, to the set value, n. The - node, n, is returned. -*/ - -extern "C" decl_node decl_putSetValue (decl_node n, decl_node t) -{ - mcDebug_assert (decl_isSetValue (n)); - n->setvalueF.type = t; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - includeSetValue - includes the range l..h into the setvalue. - h might be NIL indicating that a single element - is to be included into the set. - n is returned. -*/ - -extern "C" decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h) -{ - mcDebug_assert (decl_isSetValue (n)); - Indexing_IncludeIndiceIntoIndex (n->setvalueF.values, reinterpret_cast (l)); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getBuiltinConst - creates and returns a builtin const if available. -*/ - -extern "C" decl_node decl_getBuiltinConst (nameKey_Name n) -{ - if (n == (nameKey_makeKey ((const char *) "BITS_PER_UNIT", 13))) - { - return bitsperunitN; - } - else if (n == (nameKey_makeKey ((const char *) "BITS_PER_WORD", 13))) - { - /* avoid dangling else. */ - return bitsperwordN; - } - else if (n == (nameKey_makeKey ((const char *) "BITS_PER_CHAR", 13))) - { - /* avoid dangling else. */ - return bitspercharN; - } - else if (n == (nameKey_makeKey ((const char *) "UNITS_PER_WORD", 14))) - { - /* avoid dangling else. */ - return unitsperwordN; - } - else - { - /* avoid dangling else. */ - return NULL; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeExpList - creates and returns an expList node. -*/ - -extern "C" decl_node decl_makeExpList (void) -{ - decl_node n; - - n = newNode (decl_explist); - n->explistF.exp = Indexing_InitIndex (1); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isExpList - returns TRUE if, n, is an explist node. -*/ - -extern "C" unsigned int decl_isExpList (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_explist; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putExpList - places, expression, e, within the explist, n. -*/ - -extern "C" void decl_putExpList (decl_node n, decl_node e) -{ - mcDebug_assert (n != NULL); - mcDebug_assert (decl_isExpList (n)); - Indexing_PutIndice (n->explistF.exp, (Indexing_HighIndice (n->explistF.exp))+1, reinterpret_cast (e)); -} - - -/* - makeConstExp - returns a constexp node. -*/ - -extern "C" decl_node decl_makeConstExp (void) -{ - if ((currentModule != NULL) && (getConstExpComplete (currentModule))) - { - return decl_getNextConstExp (); - } - else - { - return doMakeConstExp (); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getNextConstExp - returns the next constexp node. -*/ - -extern "C" decl_node decl_getNextConstExp (void) -{ - decl_node n; - - mcDebug_assert (((decl_isDef (currentModule)) || (decl_isImp (currentModule))) || (decl_isModule (currentModule))); - if (decl_isDef (currentModule)) - { - return getNextFixup (¤tModule->defF.constFixup); - } - else if (decl_isImp (currentModule)) - { - /* avoid dangling else. */ - return getNextFixup (¤tModule->impF.constFixup); - } - else if (decl_isModule (currentModule)) - { - /* avoid dangling else. */ - return getNextFixup (¤tModule->moduleF.constFixup); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setConstExpComplete - sets the field inside the def or imp or module, n. -*/ - -extern "C" void decl_setConstExpComplete (decl_node n) -{ - switch (n->kind) - { - case decl_def: - n->defF.constsComplete = TRUE; - break; - - case decl_imp: - n->impF.constsComplete = TRUE; - break; - - case decl_module: - n->moduleF.constsComplete = TRUE; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - fixupConstExp - assign fixup expression, e, into the argument of, c. -*/ - -extern "C" decl_node decl_fixupConstExp (decl_node c, decl_node e) -{ - mcDebug_assert (isConstExp (c)); - c->unaryF.arg = e; - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - resetConstExpPos - resets the index into the saved list of constexps inside - module, n. -*/ - -extern "C" void decl_resetConstExpPos (decl_node n) -{ - mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n))); - if (decl_isDef (n)) - { - n->defF.constFixup.count = 0; - } - else if (decl_isImp (n)) - { - /* avoid dangling else. */ - n->impF.constFixup.count = 0; - } - else if (decl_isModule (n)) - { - /* avoid dangling else. */ - n->moduleF.constFixup.count = 0; - } -} - - -/* - makeFuncCall - builds a function call to c with param list, n. -*/ - -extern "C" decl_node decl_makeFuncCall (decl_node c, decl_node n) -{ - decl_node f; - - mcDebug_assert ((n == NULL) || (decl_isExpList (n))); - if (((c == haltN) && ((decl_getMainModule ()) != (decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5))))) && ((decl_getMainModule ()) != (decl_lookupImp (nameKey_makeKey ((const char *) "M2RTS", 5))))) - { - decl_addImportedModule (decl_getMainModule (), decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5)), FALSE); - } - f = checkIntrinsic (c, n); - checkCHeaders (c); - if (f == NULL) - { - f = newNode (decl_funccall); - f->funccallF.function = c; - f->funccallF.args = n; - f->funccallF.type = NULL; - initPair (&f->funccallF.funccallComment); - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeStatementSequence - create and return a statement sequence node. -*/ - -extern "C" decl_node decl_makeStatementSequence (void) -{ - decl_node n; - - n = newNode (decl_stmtseq); - n->stmtF.statements = Indexing_InitIndex (1); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isStatementSequence - returns TRUE if node, n, is a statement sequence. -*/ - -extern "C" unsigned int decl_isStatementSequence (decl_node n) -{ - return n->kind == decl_stmtseq; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addStatement - adds node, n, as a statement to statememt sequence, s. -*/ - -extern "C" void decl_addStatement (decl_node s, decl_node n) -{ - if (n != NULL) - { - mcDebug_assert (decl_isStatementSequence (s)); - Indexing_PutIndice (s->stmtF.statements, (Indexing_HighIndice (s->stmtF.statements))+1, reinterpret_cast (n)); - if ((isIntrinsic (n)) && n->intrinsicF.postUnreachable) - { - n->intrinsicF.postUnreachable = FALSE; - decl_addStatement (s, makeIntrinsicProc (decl_unreachable, 0, NULL)); - } - } -} - - -/* - addCommentBody - adds a body comment to a statement sequence node. -*/ - -extern "C" void decl_addCommentBody (decl_node n) -{ - mcComment_commentDesc b; - - if (n != NULL) - { - b = mcLexBuf_getBodyComment (); - if (b != NULL) - { - addGenericBody (n, decl_makeCommentS (b)); - } - } -} - - -/* - addCommentAfter - adds an after comment to a statement sequence node. -*/ - -extern "C" void decl_addCommentAfter (decl_node n) -{ - mcComment_commentDesc a; - - if (n != NULL) - { - a = mcLexBuf_getAfterComment (); - if (a != NULL) - { - addGenericAfter (n, decl_makeCommentS (a)); - } - } -} - - -/* - addIfComments - adds the, body, and, after, comments to if node, n. -*/ - -extern "C" void decl_addIfComments (decl_node n, decl_node body, decl_node after) -{ - mcDebug_assert (decl_isIf (n)); - n->ifF.ifComment.after = after; - n->ifF.ifComment.body = body; -} - - -/* - addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n. -*/ - -extern "C" void decl_addElseComments (decl_node n, decl_node body, decl_node after) -{ - mcDebug_assert ((decl_isIf (n)) || (decl_isElsif (n))); - if (decl_isIf (n)) - { - n->ifF.elseComment.after = after; - n->ifF.elseComment.body = body; - } - else - { - n->elsifF.elseComment.after = after; - n->elsifF.elseComment.body = body; - } -} - - -/* - addIfEndComments - adds the, body, and, after, comments to an, if, node, n. -*/ - -extern "C" void decl_addIfEndComments (decl_node n, decl_node body, decl_node after) -{ - mcDebug_assert (decl_isIf (n)); - n->ifF.endComment.after = after; - n->ifF.endComment.body = body; -} - - -/* - makeReturn - creates and returns a return node. -*/ - -extern "C" decl_node decl_makeReturn (void) -{ - decl_node type; - decl_node n; - - n = newNode (decl_return); - n->returnF.exp = NULL; - if (decl_isProcedure (decl_getDeclScope ())) - { - n->returnF.scope = decl_getDeclScope (); - } - else - { - n->returnF.scope = NULL; - } - initPair (&n->returnF.returnComment); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isReturn - returns TRUE if node, n, is a return. -*/ - -extern "C" unsigned int decl_isReturn (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_return; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putReturn - assigns node, e, as the expression on the return node. -*/ - -extern "C" void decl_putReturn (decl_node n, decl_node e) -{ - mcDebug_assert (decl_isReturn (n)); - n->returnF.exp = e; -} - - -/* - makeWhile - creates and returns a while node. -*/ - -extern "C" decl_node decl_makeWhile (void) -{ - decl_node n; - - n = newNode (decl_while); - n->whileF.expr = NULL; - n->whileF.statements = NULL; - initPair (&n->whileF.doComment); - initPair (&n->whileF.endComment); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putWhile - places an expression, e, and statement sequence, s, into the while - node, n. -*/ - -extern "C" void decl_putWhile (decl_node n, decl_node e, decl_node s) -{ - mcDebug_assert (decl_isWhile (n)); - n->whileF.expr = e; - n->whileF.statements = s; -} - - -/* - isWhile - returns TRUE if node, n, is a while. -*/ - -extern "C" unsigned int decl_isWhile (decl_node n) -{ - return n->kind == decl_while; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addWhileDoComment - adds body and after comments to while node, w. -*/ - -extern "C" void decl_addWhileDoComment (decl_node w, decl_node body, decl_node after) -{ - mcDebug_assert (decl_isWhile (w)); - w->whileF.doComment.after = after; - w->whileF.doComment.body = body; -} - - -/* - addWhileEndComment - adds body and after comments to the end of a while node, w. -*/ - -extern "C" void decl_addWhileEndComment (decl_node w, decl_node body, decl_node after) -{ - mcDebug_assert (decl_isWhile (w)); - w->whileF.endComment.after = after; - w->whileF.endComment.body = body; -} - - -/* - makeAssignment - creates and returns an assignment node. - The designator is, d, and expression, e. -*/ - -extern "C" decl_node decl_makeAssignment (decl_node d, decl_node e) -{ - decl_node n; - - n = newNode (decl_assignment); - n->assignmentF.des = d; - n->assignmentF.expr = e; - initPair (&n->assignmentF.assignComment); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putBegin - assigns statements, s, to be the normal part in - block, b. The block may be a procedure or module, - or implementation node. -*/ - -extern "C" void decl_putBegin (decl_node b, decl_node s) -{ - mcDebug_assert (((decl_isImp (b)) || (decl_isProcedure (b))) || (decl_isModule (b))); - switch (b->kind) - { - case decl_imp: - b->impF.beginStatements = s; - break; - - case decl_module: - b->moduleF.beginStatements = s; - break; - - case decl_procedure: - b->procedureF.beginStatements = s; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - putFinally - assigns statements, s, to be the final part in - block, b. The block may be a module - or implementation node. -*/ - -extern "C" void decl_putFinally (decl_node b, decl_node s) -{ - mcDebug_assert (((decl_isImp (b)) || (decl_isProcedure (b))) || (decl_isModule (b))); - switch (b->kind) - { - case decl_imp: - b->impF.finallyStatements = s; - break; - - case decl_module: - b->moduleF.finallyStatements = s; - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } -} - - -/* - makeExit - creates and returns an exit node. -*/ - -extern "C" decl_node decl_makeExit (decl_node l, unsigned int n) -{ - decl_node e; - - mcDebug_assert (decl_isLoop (l)); - e = newNode (decl_exit); - e->exitF.loop = l; - l->loopF.labelno = n; - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isExit - returns TRUE if node, n, is an exit. -*/ - -extern "C" unsigned int decl_isExit (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_exit; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeLoop - creates and returns a loop node. -*/ - -extern "C" decl_node decl_makeLoop (void) -{ - decl_node l; - - l = newNode (decl_loop); - l->loopF.statements = NULL; - l->loopF.labelno = 0; - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isLoop - returns TRUE if, n, is a loop node. -*/ - -extern "C" unsigned int decl_isLoop (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_loop; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putLoop - places statement sequence, s, into loop, l. -*/ - -extern "C" void decl_putLoop (decl_node l, decl_node s) -{ - mcDebug_assert (decl_isLoop (l)); - l->loopF.statements = s; -} - - -/* - makeComment - creates and returns a comment node. -*/ - -extern "C" decl_node decl_makeComment (const char *a_, unsigned int _a_high) -{ - mcComment_commentDesc c; - DynamicStrings_String s; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - c = mcComment_initComment (TRUE); - s = DynamicStrings_InitString ((const char *) a, _a_high); - mcComment_addText (c, DynamicStrings_string (s)); - s = DynamicStrings_KillString (s); - return decl_makeCommentS (c); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeCommentS - creates and returns a comment node. -*/ - -extern "C" decl_node decl_makeCommentS (mcComment_commentDesc c) -{ - decl_node n; - - if (c == NULL) - { - return NULL; - } - else - { - n = newNode (decl_comment); - n->commentF.content = c; - return n; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeIf - creates and returns an if node. The if node - will have expression, e, and statement sequence, s, - as the then component. -*/ - -extern "C" decl_node decl_makeIf (decl_node e, decl_node s) -{ - decl_node n; - - n = newNode (decl_if); - n->ifF.expr = e; - n->ifF.then = s; - n->ifF.else_ = NULL; - n->ifF.elsif = NULL; - initPair (&n->ifF.ifComment); - initPair (&n->ifF.elseComment); - initPair (&n->ifF.endComment); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isIf - returns TRUE if, n, is an if node. -*/ - -extern "C" unsigned int decl_isIf (decl_node n) -{ - return n->kind == decl_if; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeElsif - creates and returns an elsif node. - This node has an expression, e, and statement - sequence, s. -*/ - -extern "C" decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s) -{ - decl_node n; - - n = newNode (decl_elsif); - n->elsifF.expr = e; - n->elsifF.then = s; - n->elsifF.elsif = NULL; - n->elsifF.else_ = NULL; - initPair (&n->elsifF.elseComment); - mcDebug_assert ((decl_isIf (i)) || (decl_isElsif (i))); - if (decl_isIf (i)) - { - i->ifF.elsif = n; - mcDebug_assert (i->ifF.else_ == NULL); - } - else - { - i->elsifF.elsif = n; - mcDebug_assert (i->elsifF.else_ == NULL); - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isElsif - returns TRUE if node, n, is an elsif node. -*/ - -extern "C" unsigned int decl_isElsif (decl_node n) -{ - return n->kind == decl_elsif; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putElse - the else is grafted onto the if/elsif node, i, - and the statement sequence will be, s. -*/ - -extern "C" void decl_putElse (decl_node i, decl_node s) -{ - mcDebug_assert ((decl_isIf (i)) || (decl_isElsif (i))); - if (decl_isIf (i)) - { - mcDebug_assert (i->ifF.elsif == NULL); - mcDebug_assert (i->ifF.else_ == NULL); - i->ifF.else_ = s; - } - else - { - mcDebug_assert (i->elsifF.elsif == NULL); - mcDebug_assert (i->elsifF.else_ == NULL); - i->elsifF.else_ = s; - } -} - - -/* - makeFor - creates and returns a for node. -*/ - -extern "C" decl_node decl_makeFor (void) -{ - decl_node n; - - n = newNode (decl_for); - n->forF.des = NULL; - n->forF.start = NULL; - n->forF.end = NULL; - n->forF.increment = NULL; - n->forF.statements = NULL; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isFor - returns TRUE if node, n, is a for node. -*/ - -extern "C" unsigned int decl_isFor (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_for; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putFor - assigns the fields of the for node with - ident, i, - start, s, - end, e, - increment, i, - statements, sq. -*/ - -extern "C" void decl_putFor (decl_node f, decl_node i, decl_node s, decl_node e, decl_node b, decl_node sq) -{ - mcDebug_assert (decl_isFor (f)); - f->forF.des = i; - f->forF.start = s; - f->forF.end = e; - f->forF.increment = b; - f->forF.statements = sq; -} - - -/* - makeRepeat - creates and returns a repeat node. -*/ - -extern "C" decl_node decl_makeRepeat (void) -{ - decl_node n; - - n = newNode (decl_repeat); - n->repeatF.expr = NULL; - n->repeatF.statements = NULL; - initPair (&n->repeatF.repeatComment); - initPair (&n->repeatF.untilComment); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isRepeat - returns TRUE if node, n, is a repeat node. -*/ - -extern "C" unsigned int decl_isRepeat (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_repeat; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putRepeat - places statements, s, and expression, e, into - repeat statement, n. -*/ - -extern "C" void decl_putRepeat (decl_node n, decl_node s, decl_node e) -{ - n->repeatF.expr = e; - n->repeatF.statements = s; -} - - -/* - addRepeatComment - adds body and after comments to repeat node, r. -*/ - -extern "C" void decl_addRepeatComment (decl_node r, decl_node body, decl_node after) -{ - mcDebug_assert (decl_isRepeat (r)); - r->repeatF.repeatComment.after = after; - r->repeatF.repeatComment.body = body; -} - - -/* - addUntilComment - adds body and after comments to the until section of a repeat node, r. -*/ - -extern "C" void decl_addUntilComment (decl_node r, decl_node body, decl_node after) -{ - mcDebug_assert (decl_isRepeat (r)); - r->repeatF.untilComment.after = after; - r->repeatF.untilComment.body = body; -} - - -/* - makeCase - builds and returns a case statement node. -*/ - -extern "C" decl_node decl_makeCase (void) -{ - decl_node n; - - n = newNode (decl_case); - n->caseF.expression = NULL; - n->caseF.caseLabelList = Indexing_InitIndex (1); - n->caseF.else_ = NULL; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isCase - returns TRUE if node, n, is a case statement. -*/ - -extern "C" unsigned int decl_isCase (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_case; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putCaseExpression - places expression, e, into case statement, n. - n is returned. -*/ - -extern "C" decl_node decl_putCaseExpression (decl_node n, decl_node e) -{ - mcDebug_assert (decl_isCase (n)); - n->caseF.expression = e; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putCaseElse - places else statement, e, into case statement, n. - n is returned. -*/ - -extern "C" decl_node decl_putCaseElse (decl_node n, decl_node e) -{ - mcDebug_assert (decl_isCase (n)); - n->caseF.else_ = e; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putCaseStatement - places a caselist, l, and associated - statement sequence, s, into case statement, n. - n is returned. -*/ - -extern "C" decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s) -{ - mcDebug_assert (decl_isCase (n)); - mcDebug_assert (decl_isCaseList (l)); - Indexing_IncludeIndiceIntoIndex (n->caseF.caseLabelList, reinterpret_cast (decl_makeCaseLabelList (l, s))); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeCaseLabelList - creates and returns a caselabellist node. -*/ - -extern "C" decl_node decl_makeCaseLabelList (decl_node l, decl_node s) -{ - decl_node n; - - n = newNode (decl_caselabellist); - n->caselabellistF.caseList = l; - n->caselabellistF.statements = s; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isCaseLabelList - returns TRUE if, n, is a caselabellist. -*/ - -extern "C" unsigned int decl_isCaseLabelList (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_caselabellist; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeCaseList - creates and returns a case statement node. -*/ - -extern "C" decl_node decl_makeCaseList (void) -{ - decl_node n; - - n = newNode (decl_caselist); - n->caselistF.rangePairs = Indexing_InitIndex (1); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isCaseList - returns TRUE if, n, is a case list. -*/ - -extern "C" unsigned int decl_isCaseList (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_caselist; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - putCaseRange - places the case range lo..hi into caselist, n. -*/ - -extern "C" decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi) -{ - mcDebug_assert (decl_isCaseList (n)); - Indexing_IncludeIndiceIntoIndex (n->caselistF.rangePairs, reinterpret_cast (decl_makeRange (lo, hi))); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeRange - creates and returns a case range. -*/ - -extern "C" decl_node decl_makeRange (decl_node lo, decl_node hi) -{ - decl_node n; - - n = newNode (decl_range); - n->rangeF.lo = lo; - n->rangeF.hi = hi; - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isRange - returns TRUE if node, n, is a range. -*/ - -extern "C" unsigned int decl_isRange (decl_node n) -{ - mcDebug_assert (n != NULL); - return n->kind == decl_range; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setNoReturn - sets noreturn field inside procedure. -*/ - -extern "C" void decl_setNoReturn (decl_node n, unsigned int value) -{ - mcDebug_assert (n != NULL); - mcDebug_assert (decl_isProcedure (n)); - if (n->procedureF.noreturnused && (n->procedureF.noreturn != value)) - { - mcMetaError_metaError1 ((const char *) "{%1DMad} definition module and implementation module have different <* noreturn *> attributes", 93, (const unsigned char *) &n, (sizeof (n)-1)); - } - n->procedureF.noreturn = value; - n->procedureF.noreturnused = TRUE; -} - - -/* - dupExpr - duplicate the expression nodes, it does not duplicate - variables, literals, constants but only the expression - operators (including function calls and parameter lists). -*/ - -extern "C" decl_node decl_dupExpr (decl_node n) -{ - if (n == NULL) - { - return NULL; - } - else - { - return doDupExpr (n); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setLangC - -*/ - -extern "C" void decl_setLangC (void) -{ - lang = decl_ansiC; -} - - -/* - setLangCP - -*/ - -extern "C" void decl_setLangCP (void) -{ - lang = decl_ansiCP; - keyc_cp (); -} - - -/* - setLangM2 - -*/ - -extern "C" void decl_setLangM2 (void) -{ - lang = decl_pim4; -} - - -/* - out - walks the tree of node declarations for the main module - and writes the output to the outputFile specified in - mcOptions. It outputs the declarations in the language - specified above. -*/ - -extern "C" void decl_out (void) -{ - mcPretty_pretty p; - - openOutput (); - p = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln}); - switch (lang) - { - case decl_ansiC: - outC (p, decl_getMainModule ()); - break; - - case decl_ansiCP: - outC (p, decl_getMainModule ()); - break; - - case decl_pim4: - outM2 (p, decl_getMainModule ()); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1); - __builtin_unreachable (); - } - closeOutput (); -} - -extern "C" void _M2_decl_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - init (); -} - -extern "C" void _M2_decl_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gkeyc.c b/gcc/m2/mc-boot/Gkeyc.c deleted file mode 100644 index e089ac952501..000000000000 --- a/gcc/m2/mc-boot/Gkeyc.c +++ /dev/null @@ -1,1619 +0,0 @@ -/* do not edit automatically generated by mc from keyc. */ -/* keyc maintains the C name scope and avoids C/C++ name conflicts. - Copyright (C) 2016-2023 Free Software Foundation, Inc. - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _keyc_H -#define _keyc_C - -# include "GmcPretty.h" -# include "GStorage.h" -# include "GDynamicStrings.h" -# include "GsymbolKey.h" -# include "GnameKey.h" -# include "GmcOptions.h" -# include "GM2RTS.h" - -#if !defined (decl_node_D) -# define decl_node_D - typedef void *decl_node; -#endif - -typedef struct keyc__T1_r keyc__T1; - -typedef keyc__T1 *keyc_scope; - -struct keyc__T1_r { - decl_node scoped; - symbolKey_symbolTree symbols; - keyc_scope next; - }; - -static keyc_scope stack; -static keyc_scope freeList; -static symbolKey_symbolTree keywords; -static symbolKey_symbolTree macros; -static unsigned int initializedCP; -static unsigned int initializedGCC; -static unsigned int seenIntMin; -static unsigned int seenUIntMin; -static unsigned int seenLongMin; -static unsigned int seenULongMin; -static unsigned int seenCharMin; -static unsigned int seenUCharMin; -static unsigned int seenIntMax; -static unsigned int seenUIntMax; -static unsigned int seenLongMax; -static unsigned int seenULongMax; -static unsigned int seenCharMax; -static unsigned int seenUCharMax; -static unsigned int seenLabs; -static unsigned int seenAbs; -static unsigned int seenFabs; -static unsigned int seenFabsl; -static unsigned int seenSize_t; -static unsigned int seenSSize_t; -static unsigned int seenUnistd; -static unsigned int seenSysTypes; -static unsigned int seenThrow; -static unsigned int seenFree; -static unsigned int seenMalloc; -static unsigned int seenStorage; -static unsigned int seenProc; -static unsigned int seenTrue; -static unsigned int seenFalse; -static unsigned int seenNull; -static unsigned int seenMemcpy; -static unsigned int seenException; -static unsigned int seenComplex; -static unsigned int seenM2RTS; -static unsigned int seenStrlen; -static unsigned int seenCtype; - -/* - useUnistd - need to use unistd.h call using open/close/read/write require this header. -*/ - -extern "C" void keyc_useUnistd (void); - -/* - useThrow - use the throw function. -*/ - -extern "C" void keyc_useThrow (void); - -/* - useStorage - indicate we have used storage. -*/ - -extern "C" void keyc_useStorage (void); - -/* - useFree - indicate we have used free. -*/ - -extern "C" void keyc_useFree (void); - -/* - useMalloc - indicate we have used malloc. -*/ - -extern "C" void keyc_useMalloc (void); - -/* - useProc - indicate we have used proc. -*/ - -extern "C" void keyc_useProc (void); - -/* - useTrue - indicate we have used TRUE. -*/ - -extern "C" void keyc_useTrue (void); - -/* - useFalse - indicate we have used FALSE. -*/ - -extern "C" void keyc_useFalse (void); - -/* - useNull - indicate we have used NULL. -*/ - -extern "C" void keyc_useNull (void); - -/* - useMemcpy - indicate we have used memcpy. -*/ - -extern "C" void keyc_useMemcpy (void); - -/* - useIntMin - indicate we have used INT_MIN. -*/ - -extern "C" void keyc_useIntMin (void); - -/* - useUIntMin - indicate we have used UINT_MIN. -*/ - -extern "C" void keyc_useUIntMin (void); - -/* - useLongMin - indicate we have used LONG_MIN. -*/ - -extern "C" void keyc_useLongMin (void); - -/* - useULongMin - indicate we have used ULONG_MIN. -*/ - -extern "C" void keyc_useULongMin (void); - -/* - useCharMin - indicate we have used CHAR_MIN. -*/ - -extern "C" void keyc_useCharMin (void); - -/* - useUCharMin - indicate we have used UCHAR_MIN. -*/ - -extern "C" void keyc_useUCharMin (void); - -/* - useIntMax - indicate we have used INT_MAX. -*/ - -extern "C" void keyc_useIntMax (void); - -/* - useUIntMax - indicate we have used UINT_MAX. -*/ - -extern "C" void keyc_useUIntMax (void); - -/* - useLongMax - indicate we have used LONG_MAX. -*/ - -extern "C" void keyc_useLongMax (void); - -/* - useULongMax - indicate we have used ULONG_MAX. -*/ - -extern "C" void keyc_useULongMax (void); - -/* - useCharMax - indicate we have used CHAR_MAX. -*/ - -extern "C" void keyc_useCharMax (void); - -/* - useUCharMax - indicate we have used UChar_MAX. -*/ - -extern "C" void keyc_useUCharMax (void); - -/* - useSize_t - indicate we have used size_t. -*/ - -extern "C" void keyc_useSize_t (void); - -/* - useSSize_t - indicate we have used ssize_t. -*/ - -extern "C" void keyc_useSSize_t (void); - -/* - useLabs - indicate we have used labs. -*/ - -extern "C" void keyc_useLabs (void); - -/* - useAbs - indicate we have used abs. -*/ - -extern "C" void keyc_useAbs (void); - -/* - useFabs - indicate we have used fabs. -*/ - -extern "C" void keyc_useFabs (void); - -/* - useFabsl - indicate we have used fabsl. -*/ - -extern "C" void keyc_useFabsl (void); - -/* - useException - use the exceptions module, mcrts. -*/ - -extern "C" void keyc_useException (void); - -/* - useComplex - use the complex data type. -*/ - -extern "C" void keyc_useComplex (void); - -/* - useM2RTS - indicate we have used M2RTS in the converted code. -*/ - -extern "C" void keyc_useM2RTS (void); - -/* - useStrlen - indicate we have used strlen in the converted code. -*/ - -extern "C" void keyc_useStrlen (void); - -/* - useCtype - indicate we have used the toupper function. -*/ - -extern "C" void keyc_useCtype (void); - -/* - genDefs - generate definitions or includes for all - macros and prototypes used. -*/ - -extern "C" void keyc_genDefs (mcPretty_pretty p); - -/* - genConfigSystem - generate include files for config.h and system.h - within the GCC framework. -*/ - -extern "C" void keyc_genConfigSystem (mcPretty_pretty p); - -/* - enterScope - enter a scope defined by, n. -*/ - -extern "C" void keyc_enterScope (decl_node n); - -/* - leaveScope - leave the scope defined by, n. -*/ - -extern "C" void keyc_leaveScope (decl_node n); - -/* - cname - attempts to declare a symbol with name, n, in the - current scope. If there is no conflict with the - target language then NIL is returned, otherwise - a mangled name is returned as a String. - If scopes is FALSE then only the keywords and - macros are detected for a clash (all scoping - is ignored). -*/ - -extern "C" DynamicStrings_String keyc_cname (nameKey_Name n, unsigned int scopes); - -/* - cnamen - attempts to declare a symbol with name, n, in the - current scope. If there is no conflict with the - target language then NIL is returned, otherwise - a mangled name is returned as a Name - If scopes is FALSE then only the keywords and - macros are detected for a clash (all scoping - is ignored). -*/ - -extern "C" nameKey_Name keyc_cnamen (nameKey_Name n, unsigned int scopes); - -/* - cp - include C++ keywords and standard declarations to avoid. -*/ - -extern "C" void keyc_cp (void); - -/* - checkGccConfigSystem - issues the GCC include config.h, include system.h - instead of the standard host include. -*/ - -static void checkGccConfigSystem (mcPretty_pretty p); - -/* - checkCtype - -*/ - -static void checkCtype (mcPretty_pretty p); - -/* - checkAbs - check to see if the abs family, size_t or ssize_t have been used. -*/ - -static void checkAbs (mcPretty_pretty p); - -/* - checkLimits - -*/ - -static void checkLimits (mcPretty_pretty p); - -/* - checkFreeMalloc - -*/ - -static void checkFreeMalloc (mcPretty_pretty p); - -/* - checkStorage - -*/ - -static void checkStorage (mcPretty_pretty p); - -/* - checkProc - -*/ - -static void checkProc (mcPretty_pretty p); - -/* - checkTrue - -*/ - -static void checkTrue (mcPretty_pretty p); - -/* - checkFalse - -*/ - -static void checkFalse (mcPretty_pretty p); - -/* - checkNull - -*/ - -static void checkNull (mcPretty_pretty p); - -/* - checkMemcpy - -*/ - -static void checkMemcpy (mcPretty_pretty p); - -/* - checkM2RTS - -*/ - -static void checkM2RTS (mcPretty_pretty p); - -/* - checkException - check to see if exceptions were used. -*/ - -static void checkException (mcPretty_pretty p); - -/* - checkThrow - check to see if the throw function is used. -*/ - -static void checkThrow (mcPretty_pretty p); - -/* - checkUnistd - check to see if the unistd.h header file is required. -*/ - -static void checkUnistd (mcPretty_pretty p); - -/* - checkComplex - check to see if the type complex was used. -*/ - -static void checkComplex (mcPretty_pretty p); - -/* - checkSysTypes - emit header for sys/types.h if necessary. -*/ - -static void checkSysTypes (mcPretty_pretty p); - -/* - fixNullPointerConst - fixup for NULL on some C++11 systems. -*/ - -static void fixNullPointerConst (mcPretty_pretty p); - -/* - new - -*/ - -static keyc_scope new_ (decl_node n); - -/* - mangle1 - returns TRUE if name is unique if we add _ - to its end. -*/ - -static unsigned int mangle1 (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes); - -/* - mangle2 - returns TRUE if name is unique if we prepend _ - to, n. -*/ - -static unsigned int mangle2 (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes); - -/* - mangleN - keep adding '_' to the end of n until it - no longer clashes. -*/ - -static unsigned int mangleN (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes); - -/* - clash - returns TRUE if there is a clash with name, n, - in the current scope or C keywords or C macros. -*/ - -static unsigned int clash (nameKey_Name n, unsigned int scopes); - -/* - initCP - add the extra keywords and standard definitions used by C++. -*/ - -static void initCP (void); - -/* - add - -*/ - -static void add (symbolKey_symbolTree s, const char *a_, unsigned int _a_high); - -/* - initMacros - macros and library function names to avoid. -*/ - -static void initMacros (void); - -/* - initKeywords - keywords to avoid. -*/ - -static void initKeywords (void); - -/* - init - -*/ - -static void init (void); - - -/* - checkGccConfigSystem - issues the GCC include config.h, include system.h - instead of the standard host include. -*/ - -static void checkGccConfigSystem (mcPretty_pretty p) -{ - if (mcOptions_getGccConfigSystem ()) - { - if (! initializedGCC) - { - initializedGCC = TRUE; - mcPretty_print (p, (const char *) "#include \"config.h\"\\n", 21); - mcPretty_print (p, (const char *) "#include \"system.h\"\\n", 21); - } - } -} - - -/* - checkCtype - -*/ - -static void checkCtype (mcPretty_pretty p) -{ - if (seenCtype) - { - checkGccConfigSystem (p); - if (mcOptions_getGccConfigSystem ()) - { - /* GCC header files use a safe variant. */ - mcPretty_print (p, (const char *) "#include \\n", 25); - } - else - { - mcPretty_print (p, (const char *) "#include \\n", 20); - } - } -} - - -/* - checkAbs - check to see if the abs family, size_t or ssize_t have been used. -*/ - -static void checkAbs (mcPretty_pretty p) -{ - if (((((seenLabs || seenAbs) || seenFabs) || seenFabsl) || seenSize_t) || seenSSize_t) - { - checkGccConfigSystem (p); - if (! (mcOptions_getGccConfigSystem ())) - { - mcPretty_print (p, (const char *) "#include \\n", 21); - } - } -} - - -/* - checkLimits - -*/ - -static void checkLimits (mcPretty_pretty p) -{ - if ((((((((((((seenMemcpy || seenIntMin) || seenUIntMin) || seenLongMin) || seenULongMin) || seenCharMin) || seenUCharMin) || seenIntMax) || seenUIntMax) || seenLongMax) || seenULongMax) || seenCharMax) || seenUCharMax) /* OR seenUIntMax */ - { - checkGccConfigSystem (p); - if (! (mcOptions_getGccConfigSystem ())) - { - mcPretty_print (p, (const char *) "#include \\n", 21); - } - } -} - - -/* - checkFreeMalloc - -*/ - -static void checkFreeMalloc (mcPretty_pretty p) -{ - if (seenFree || seenMalloc) - { - checkGccConfigSystem (p); - if (! (mcOptions_getGccConfigSystem ())) - { - mcPretty_print (p, (const char *) "#include \\n", 21); - } - } -} - - -/* - checkStorage - -*/ - -static void checkStorage (mcPretty_pretty p) -{ - if (seenStorage) - { - mcPretty_print (p, (const char *) "# include \"", 13); - mcPretty_prints (p, mcOptions_getHPrefix ()); - mcPretty_print (p, (const char *) "Storage.h\"\\n", 12); - } -} - - -/* - checkProc - -*/ - -static void checkProc (mcPretty_pretty p) -{ - if (seenProc) - { - mcPretty_print (p, (const char *) "# if !defined (PROC_D)\\n", 26); - mcPretty_print (p, (const char *) "# define PROC_D\\n", 22); - mcPretty_print (p, (const char *) " typedef void (*PROC_t) (void);\\n", 39); - mcPretty_print (p, (const char *) " typedef struct { PROC_t proc; } PROC;\\n", 46); - mcPretty_print (p, (const char *) "# endif\\n\\n", 13); - } -} - - -/* - checkTrue - -*/ - -static void checkTrue (mcPretty_pretty p) -{ - if (seenTrue) - { - mcPretty_print (p, (const char *) "# if !defined (TRUE)\\n", 24); - mcPretty_print (p, (const char *) "# define TRUE (1==1)\\n", 27); - mcPretty_print (p, (const char *) "# endif\\n\\n", 13); - } -} - - -/* - checkFalse - -*/ - -static void checkFalse (mcPretty_pretty p) -{ - if (seenFalse) - { - mcPretty_print (p, (const char *) "# if !defined (FALSE)\\n", 25); - mcPretty_print (p, (const char *) "# define FALSE (1==0)\\n", 28); - mcPretty_print (p, (const char *) "# endif\\n\\n", 13); - } -} - - -/* - checkNull - -*/ - -static void checkNull (mcPretty_pretty p) -{ - if (seenNull) - { - checkGccConfigSystem (p); - if (! (mcOptions_getGccConfigSystem ())) - { - mcPretty_print (p, (const char *) "#include \\n", 21); - } - } -} - - -/* - checkMemcpy - -*/ - -static void checkMemcpy (mcPretty_pretty p) -{ - if (seenMemcpy || seenStrlen) - { - checkGccConfigSystem (p); - if (! (mcOptions_getGccConfigSystem ())) - { - mcPretty_print (p, (const char *) "#include \\n", 21); - } - } -} - - -/* - checkM2RTS - -*/ - -static void checkM2RTS (mcPretty_pretty p) -{ - if (seenM2RTS) - { - mcPretty_print (p, (const char *) "# include \"", 13); - mcPretty_prints (p, mcOptions_getHPrefix ()); - mcPretty_print (p, (const char *) "M2RTS.h\"\\n", 10); - } -} - - -/* - checkException - check to see if exceptions were used. -*/ - -static void checkException (mcPretty_pretty p) -{ - if (seenException) - { - mcPretty_print (p, (const char *) "# include \"Gmcrts.h\"\\n", 24); - } -} - - -/* - checkThrow - check to see if the throw function is used. -*/ - -static void checkThrow (mcPretty_pretty p) -{ - if (seenThrow) - { - /* print (p, '# include "sys/cdefs.h" - ') ; */ - mcPretty_print (p, (const char *) "#ifndef __cplusplus\\n", 21); - mcPretty_print (p, (const char *) "extern void throw (unsigned int);\\n", 35); - mcPretty_print (p, (const char *) "#endif\\n", 8); - } -} - - -/* - checkUnistd - check to see if the unistd.h header file is required. -*/ - -static void checkUnistd (mcPretty_pretty p) -{ - if (seenUnistd) - { - checkGccConfigSystem (p); - if (! (mcOptions_getGccConfigSystem ())) - { - mcPretty_print (p, (const char *) "#include \\n", 21); - } - } -} - - -/* - checkComplex - check to see if the type complex was used. -*/ - -static void checkComplex (mcPretty_pretty p) -{ - if (seenComplex) - { - checkGccConfigSystem (p); - if (! (mcOptions_getGccConfigSystem ())) - { - mcPretty_print (p, (const char *) "# include \\n", 25); - } - } -} - - -/* - checkSysTypes - emit header for sys/types.h if necessary. -*/ - -static void checkSysTypes (mcPretty_pretty p) -{ - if (seenSysTypes) - { - checkGccConfigSystem (p); - if (! (mcOptions_getGccConfigSystem ())) - { - mcPretty_print (p, (const char *) "# include \\n", 27); - } - } -} - - -/* - fixNullPointerConst - fixup for NULL on some C++11 systems. -*/ - -static void fixNullPointerConst (mcPretty_pretty p) -{ - if (seenNull) - { - mcPretty_print (p, (const char *) "#if defined(__cplusplus)\\n", 26); - mcPretty_print (p, (const char *) "# undef NULL\\n", 16); - mcPretty_print (p, (const char *) "# define NULL 0\\n", 19); - mcPretty_print (p, (const char *) "#endif\\n", 8); - } -} - - -/* - new - -*/ - -static keyc_scope new_ (decl_node n) -{ - keyc_scope s; - - if (freeList == NULL) - { - Storage_ALLOCATE ((void **) &s, sizeof (keyc__T1)); - } - else - { - s = freeList; - freeList = freeList->next; - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - mangle1 - returns TRUE if name is unique if we add _ - to its end. -*/ - -static unsigned int mangle1 (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes) -{ - (*m) = DynamicStrings_KillString ((*m)); - (*m) = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); - (*m) = DynamicStrings_ConCatChar ((*m), '_'); - return ! (clash (nameKey_makekey (DynamicStrings_string ((*m))), scopes)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - mangle2 - returns TRUE if name is unique if we prepend _ - to, n. -*/ - -static unsigned int mangle2 (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes) -{ - (*m) = DynamicStrings_KillString ((*m)); - (*m) = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); - (*m) = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "_", 1), DynamicStrings_Mark ((*m))); - return ! (clash (nameKey_makekey (DynamicStrings_string ((*m))), scopes)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - mangleN - keep adding '_' to the end of n until it - no longer clashes. -*/ - -static unsigned int mangleN (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes) -{ - (*m) = DynamicStrings_KillString ((*m)); - (*m) = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)); - for (;;) - { - (*m) = DynamicStrings_ConCatChar ((*m), '_'); - if (! (clash (nameKey_makekey (DynamicStrings_string ((*m))), scopes))) - { - return TRUE; - } - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/keyc.def", 20, 1); - __builtin_unreachable (); -} - - -/* - clash - returns TRUE if there is a clash with name, n, - in the current scope or C keywords or C macros. -*/ - -static unsigned int clash (nameKey_Name n, unsigned int scopes) -{ - if (((symbolKey_getSymKey (macros, n)) != NULL) || ((symbolKey_getSymKey (keywords, n)) != NULL)) - { - return TRUE; - } - return scopes && ((symbolKey_getSymKey (stack->symbols, n)) != NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - initCP - add the extra keywords and standard definitions used by C++. -*/ - -static void initCP (void) -{ - add (keywords, (const char *) "delete", 6); - add (keywords, (const char *) "try", 3); - add (keywords, (const char *) "catch", 5); - add (keywords, (const char *) "operator", 8); - add (keywords, (const char *) "complex", 7); - add (keywords, (const char *) "export", 6); - add (keywords, (const char *) "public", 6); -} - - -/* - add - -*/ - -static void add (symbolKey_symbolTree s, const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - symbolKey_putSymKey (s, nameKey_makeKey ((const char *) a, _a_high), reinterpret_cast (DynamicStrings_InitString ((const char *) a, _a_high))); -} - - -/* - initMacros - macros and library function names to avoid. -*/ - -static void initMacros (void) -{ - macros = symbolKey_initTree (); - add (macros, (const char *) "FILE", 4); - add (macros, (const char *) "EOF", 3); - add (macros, (const char *) "stdio", 5); - add (macros, (const char *) "stdout", 6); - add (macros, (const char *) "stderr", 6); - add (macros, (const char *) "write", 5); - add (macros, (const char *) "read", 4); - add (macros, (const char *) "exit", 4); - add (macros, (const char *) "abs", 3); - add (macros, (const char *) "optarg", 6); - add (macros, (const char *) "div", 3); - add (macros, (const char *) "sin", 3); - add (macros, (const char *) "cos", 3); - add (macros, (const char *) "tan", 3); - add (macros, (const char *) "log10", 5); - add (macros, (const char *) "trunc", 5); - add (macros, (const char *) "I", 1); - add (macros, (const char *) "csqrt", 5); - add (macros, (const char *) "strlen", 6); - add (macros, (const char *) "strcpy", 6); - add (macros, (const char *) "free", 4); - add (macros, (const char *) "malloc", 6); - add (macros, (const char *) "time", 4); - add (macros, (const char *) "main", 4); - add (macros, (const char *) "true", 4); - add (macros, (const char *) "false", 5); - add (macros, (const char *) "sigfpe", 6); -} - - -/* - initKeywords - keywords to avoid. -*/ - -static void initKeywords (void) -{ - keywords = symbolKey_initTree (); - add (keywords, (const char *) "auto", 4); - add (keywords, (const char *) "break", 5); - add (keywords, (const char *) "case", 4); - add (keywords, (const char *) "char", 4); - add (keywords, (const char *) "const", 5); - add (keywords, (const char *) "continue", 8); - add (keywords, (const char *) "default", 7); - add (keywords, (const char *) "do", 2); - add (keywords, (const char *) "double", 6); - add (keywords, (const char *) "else", 4); - add (keywords, (const char *) "enum", 4); - add (keywords, (const char *) "extern", 6); - add (keywords, (const char *) "float", 5); - add (keywords, (const char *) "for", 3); - add (keywords, (const char *) "goto", 4); - add (keywords, (const char *) "if", 2); - add (keywords, (const char *) "int", 3); - add (keywords, (const char *) "long", 4); - add (keywords, (const char *) "register", 8); - add (keywords, (const char *) "return", 6); - add (keywords, (const char *) "short", 5); - add (keywords, (const char *) "signed", 6); - add (keywords, (const char *) "sizeof", 6); - add (keywords, (const char *) "static", 6); - add (keywords, (const char *) "struct", 6); - add (keywords, (const char *) "switch", 6); - add (keywords, (const char *) "typedef", 7); - add (keywords, (const char *) "union", 5); - add (keywords, (const char *) "unsigned", 8); - add (keywords, (const char *) "void", 4); - add (keywords, (const char *) "volatile", 8); - add (keywords, (const char *) "while", 5); - add (keywords, (const char *) "and", 3); - add (keywords, (const char *) "or", 2); - add (keywords, (const char *) "not", 3); - add (keywords, (const char *) "throw", 5); - add (keywords, (const char *) "new", 3); -} - - -/* - init - -*/ - -static void init (void) -{ - seenUnistd = FALSE; - seenThrow = FALSE; - seenFree = FALSE; - seenMalloc = FALSE; - seenStorage = FALSE; - seenProc = FALSE; - seenTrue = FALSE; - seenFalse = FALSE; - seenNull = FALSE; - seenMemcpy = FALSE; - seenIntMin = FALSE; - seenUIntMin = FALSE; - seenLongMin = FALSE; - seenULongMin = FALSE; - seenCharMin = FALSE; - seenUCharMin = FALSE; - seenIntMax = FALSE; - seenUIntMax = FALSE; - seenLongMax = FALSE; - seenULongMax = FALSE; - seenCharMax = FALSE; - seenUCharMax = FALSE; - seenLabs = FALSE; - seenAbs = FALSE; - seenFabs = FALSE; - seenFabsl = FALSE; - seenException = FALSE; - seenComplex = FALSE; - seenM2RTS = FALSE; - seenStrlen = FALSE; - seenCtype = FALSE; - seenSize_t = FALSE; - seenSSize_t = FALSE; - seenSysTypes = FALSE; - initializedCP = FALSE; - initializedGCC = FALSE; - stack = NULL; - freeList = NULL; - initKeywords (); - initMacros (); -} - - -/* - useUnistd - need to use unistd.h call using open/close/read/write require this header. -*/ - -extern "C" void keyc_useUnistd (void) -{ - seenUnistd = TRUE; -} - - -/* - useThrow - use the throw function. -*/ - -extern "C" void keyc_useThrow (void) -{ - seenThrow = TRUE; -} - - -/* - useStorage - indicate we have used storage. -*/ - -extern "C" void keyc_useStorage (void) -{ - seenStorage = TRUE; -} - - -/* - useFree - indicate we have used free. -*/ - -extern "C" void keyc_useFree (void) -{ - seenFree = TRUE; -} - - -/* - useMalloc - indicate we have used malloc. -*/ - -extern "C" void keyc_useMalloc (void) -{ - seenMalloc = TRUE; -} - - -/* - useProc - indicate we have used proc. -*/ - -extern "C" void keyc_useProc (void) -{ - seenProc = TRUE; -} - - -/* - useTrue - indicate we have used TRUE. -*/ - -extern "C" void keyc_useTrue (void) -{ - seenTrue = TRUE; -} - - -/* - useFalse - indicate we have used FALSE. -*/ - -extern "C" void keyc_useFalse (void) -{ - seenFalse = TRUE; -} - - -/* - useNull - indicate we have used NULL. -*/ - -extern "C" void keyc_useNull (void) -{ - seenNull = TRUE; -} - - -/* - useMemcpy - indicate we have used memcpy. -*/ - -extern "C" void keyc_useMemcpy (void) -{ - seenMemcpy = TRUE; -} - - -/* - useIntMin - indicate we have used INT_MIN. -*/ - -extern "C" void keyc_useIntMin (void) -{ - seenIntMin = TRUE; -} - - -/* - useUIntMin - indicate we have used UINT_MIN. -*/ - -extern "C" void keyc_useUIntMin (void) -{ - seenUIntMin = TRUE; -} - - -/* - useLongMin - indicate we have used LONG_MIN. -*/ - -extern "C" void keyc_useLongMin (void) -{ - seenLongMin = TRUE; -} - - -/* - useULongMin - indicate we have used ULONG_MIN. -*/ - -extern "C" void keyc_useULongMin (void) -{ - seenULongMin = TRUE; -} - - -/* - useCharMin - indicate we have used CHAR_MIN. -*/ - -extern "C" void keyc_useCharMin (void) -{ - seenCharMin = TRUE; -} - - -/* - useUCharMin - indicate we have used UCHAR_MIN. -*/ - -extern "C" void keyc_useUCharMin (void) -{ - seenUCharMin = TRUE; -} - - -/* - useIntMax - indicate we have used INT_MAX. -*/ - -extern "C" void keyc_useIntMax (void) -{ - seenIntMax = TRUE; -} - - -/* - useUIntMax - indicate we have used UINT_MAX. -*/ - -extern "C" void keyc_useUIntMax (void) -{ - seenUIntMax = TRUE; -} - - -/* - useLongMax - indicate we have used LONG_MAX. -*/ - -extern "C" void keyc_useLongMax (void) -{ - seenLongMax = TRUE; -} - - -/* - useULongMax - indicate we have used ULONG_MAX. -*/ - -extern "C" void keyc_useULongMax (void) -{ - seenULongMax = TRUE; -} - - -/* - useCharMax - indicate we have used CHAR_MAX. -*/ - -extern "C" void keyc_useCharMax (void) -{ - seenCharMax = TRUE; -} - - -/* - useUCharMax - indicate we have used UChar_MAX. -*/ - -extern "C" void keyc_useUCharMax (void) -{ - seenUCharMax = TRUE; -} - - -/* - useSize_t - indicate we have used size_t. -*/ - -extern "C" void keyc_useSize_t (void) -{ - seenSize_t = TRUE; -} - - -/* - useSSize_t - indicate we have used ssize_t. -*/ - -extern "C" void keyc_useSSize_t (void) -{ - seenSSize_t = TRUE; - seenSysTypes = TRUE; -} - - -/* - useLabs - indicate we have used labs. -*/ - -extern "C" void keyc_useLabs (void) -{ - seenLabs = TRUE; -} - - -/* - useAbs - indicate we have used abs. -*/ - -extern "C" void keyc_useAbs (void) -{ - seenAbs = TRUE; -} - - -/* - useFabs - indicate we have used fabs. -*/ - -extern "C" void keyc_useFabs (void) -{ - seenFabs = TRUE; -} - - -/* - useFabsl - indicate we have used fabsl. -*/ - -extern "C" void keyc_useFabsl (void) -{ - seenFabsl = TRUE; -} - - -/* - useException - use the exceptions module, mcrts. -*/ - -extern "C" void keyc_useException (void) -{ - seenException = TRUE; -} - - -/* - useComplex - use the complex data type. -*/ - -extern "C" void keyc_useComplex (void) -{ - seenComplex = TRUE; -} - - -/* - useM2RTS - indicate we have used M2RTS in the converted code. -*/ - -extern "C" void keyc_useM2RTS (void) -{ - seenM2RTS = TRUE; -} - - -/* - useStrlen - indicate we have used strlen in the converted code. -*/ - -extern "C" void keyc_useStrlen (void) -{ - seenStrlen = TRUE; -} - - -/* - useCtype - indicate we have used the toupper function. -*/ - -extern "C" void keyc_useCtype (void) -{ - seenCtype = TRUE; -} - - -/* - genDefs - generate definitions or includes for all - macros and prototypes used. -*/ - -extern "C" void keyc_genDefs (mcPretty_pretty p) -{ - checkFreeMalloc (p); - checkProc (p); - checkTrue (p); - checkFalse (p); - checkNull (p); - checkMemcpy (p); - checkLimits (p); - checkAbs (p); - checkStorage (p); - checkException (p); - checkComplex (p); - checkCtype (p); - checkUnistd (p); - checkSysTypes (p); - checkM2RTS (p); - checkThrow (p); - fixNullPointerConst (p); -} - - -/* - genConfigSystem - generate include files for config.h and system.h - within the GCC framework. -*/ - -extern "C" void keyc_genConfigSystem (mcPretty_pretty p) -{ - checkGccConfigSystem (p); -} - - -/* - enterScope - enter a scope defined by, n. -*/ - -extern "C" void keyc_enterScope (decl_node n) -{ - keyc_scope s; - - s = new_ (n); - s->scoped = n; - s->symbols = symbolKey_initTree (); - s->next = stack; - stack = s; -} - - -/* - leaveScope - leave the scope defined by, n. -*/ - -extern "C" void keyc_leaveScope (decl_node n) -{ - keyc_scope s; - - if (n == stack->scoped) - { - s = stack; - stack = stack->next; - s->scoped = static_cast (NULL); - symbolKey_killTree (&s->symbols); - s->next = NULL; - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - cname - attempts to declare a symbol with name, n, in the - current scope. If there is no conflict with the - target language then NIL is returned, otherwise - a mangled name is returned as a String. - If scopes is FALSE then only the keywords and - macros are detected for a clash (all scoping - is ignored). -*/ - -extern "C" DynamicStrings_String keyc_cname (nameKey_Name n, unsigned int scopes) -{ - DynamicStrings_String m; - - m = static_cast (NULL); - if (clash (n, scopes)) - { - if (((mangle1 (n, &m, scopes)) || (mangle2 (n, &m, scopes))) || (mangleN (n, &m, scopes))) - { - /* avoid dangling else. */ - if (scopes) - { - /* no longer a clash with, m, so add it to the current scope. */ - n = nameKey_makekey (DynamicStrings_string (m)); - symbolKey_putSymKey (stack->symbols, n, reinterpret_cast (m)); - } - } - else - { - /* mangleN must always succeed. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - else if (scopes) - { - /* avoid dangling else. */ - /* no clash, add it to the current scope. */ - symbolKey_putSymKey (stack->symbols, n, reinterpret_cast (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)))); - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - cnamen - attempts to declare a symbol with name, n, in the - current scope. If there is no conflict with the - target language then NIL is returned, otherwise - a mangled name is returned as a Name - If scopes is FALSE then only the keywords and - macros are detected for a clash (all scoping - is ignored). -*/ - -extern "C" nameKey_Name keyc_cnamen (nameKey_Name n, unsigned int scopes) -{ - DynamicStrings_String m; - - m = static_cast (NULL); - if (clash (n, scopes)) - { - if (((mangle1 (n, &m, scopes)) || (mangle2 (n, &m, scopes))) || (mangleN (n, &m, scopes))) - { - /* avoid dangling else. */ - n = nameKey_makekey (DynamicStrings_string (m)); - if (scopes) - { - /* no longer a clash with, m, so add it to the current scope. */ - symbolKey_putSymKey (stack->symbols, n, reinterpret_cast (m)); - } - } - else - { - /* mangleN must always succeed. */ - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - else if (scopes) - { - /* avoid dangling else. */ - /* no clash, add it to the current scope. */ - symbolKey_putSymKey (stack->symbols, n, reinterpret_cast (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)))); - } - m = DynamicStrings_KillString (m); - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - cp - include C++ keywords and standard declarations to avoid. -*/ - -extern "C" void keyc_cp (void) -{ - if (! initializedCP) - { - initializedCP = TRUE; - initCP (); - } -} - -extern "C" void _M2_keyc_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - init (); -} - -extern "C" void _M2_keyc_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Glists.c b/gcc/m2/mc-boot/Glists.c deleted file mode 100644 index 63bced70ffda..000000000000 --- a/gcc/m2/mc-boot/Glists.c +++ /dev/null @@ -1,439 +0,0 @@ -/* do not edit automatically generated by mc from lists. */ -/* Dynamic list library for pointers. - Copyright (C) 2015-2023 Free Software Foundation, Inc. - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _lists_H -#define _lists_C - -# include "GStorage.h" - -typedef struct symbolKey_performOperation_p symbolKey_performOperation; - -# define MaxnoOfelements 5 -typedef struct lists__T1_r lists__T1; - -typedef struct lists__T2_a lists__T2; - -typedef lists__T1 *lists_list; - -typedef void (*symbolKey_performOperation_t) (void *); -struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; }; - -struct lists__T2_a { void * array[MaxnoOfelements-1+1]; }; -struct lists__T1_r { - unsigned int noOfelements; - lists__T2 elements; - lists_list next; - }; - - -/* - initList - creates a new list, l. -*/ - -extern "C" lists_list lists_initList (void); - -/* - killList - deletes the complete list, l. -*/ - -extern "C" void lists_killList (lists_list *l); - -/* - putItemIntoList - places an ADDRESS, c, into list, l. -*/ - -extern "C" void lists_putItemIntoList (lists_list l, void * c); - -/* - getItemFromList - retrieves the nth WORD from list, l. -*/ - -extern "C" void * lists_getItemFromList (lists_list l, unsigned int n); - -/* - getIndexOfList - returns the index for WORD, c, in list, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int lists_getIndexOfList (lists_list l, void * c); - -/* - noOfItemsInList - returns the number of items in list, l. -*/ - -extern "C" unsigned int lists_noOfItemsInList (lists_list l); - -/* - includeItemIntoList - adds an ADDRESS, c, into a list providing - the value does not already exist. -*/ - -extern "C" void lists_includeItemIntoList (lists_list l, void * c); - -/* - removeItemFromList - removes a ADDRESS, c, from a list. - It assumes that this value only appears once. -*/ - -extern "C" void lists_removeItemFromList (lists_list l, void * c); - -/* - isItemInList - returns true if a ADDRESS, c, was found in list, l. -*/ - -extern "C" unsigned int lists_isItemInList (lists_list l, void * c); - -/* - foreachItemInListDo - calls procedure, P, foreach item in list, l. -*/ - -extern "C" void lists_foreachItemInListDo (lists_list l, symbolKey_performOperation p); - -/* - duplicateList - returns a duplicate list derived from, l. -*/ - -extern "C" lists_list lists_duplicateList (lists_list l); - -/* - removeItem - remove an element at index, i, from the list data type. -*/ - -static void removeItem (lists_list p, lists_list l, unsigned int i); - - -/* - removeItem - remove an element at index, i, from the list data type. -*/ - -static void removeItem (lists_list p, lists_list l, unsigned int i) -{ - l->noOfelements -= 1; - while (i <= l->noOfelements) - { - l->elements.array[i-1] = l->elements.array[i+1-1]; - i += 1; - } - if ((l->noOfelements == 0) && (p != NULL)) - { - p->next = l->next; - Storage_DEALLOCATE ((void **) &l, sizeof (lists__T1)); - } -} - - -/* - initList - creates a new list, l. -*/ - -extern "C" lists_list lists_initList (void) -{ - lists_list l; - - Storage_ALLOCATE ((void **) &l, sizeof (lists__T1)); - l->noOfelements = 0; - l->next = NULL; - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - killList - deletes the complete list, l. -*/ - -extern "C" void lists_killList (lists_list *l) -{ - if ((*l) != NULL) - { - if ((*l)->next != NULL) - { - lists_killList (&(*l)->next); - } - Storage_DEALLOCATE ((void **) &(*l), sizeof (lists__T1)); - } -} - - -/* - putItemIntoList - places an ADDRESS, c, into list, l. -*/ - -extern "C" void lists_putItemIntoList (lists_list l, void * c) -{ - if (l->noOfelements < MaxnoOfelements) - { - l->noOfelements += 1; - l->elements.array[l->noOfelements-1] = c; - } - else if (l->next != NULL) - { - /* avoid dangling else. */ - lists_putItemIntoList (l->next, c); - } - else - { - /* avoid dangling else. */ - l->next = lists_initList (); - lists_putItemIntoList (l->next, c); - } -} - - -/* - getItemFromList - retrieves the nth WORD from list, l. -*/ - -extern "C" void * lists_getItemFromList (lists_list l, unsigned int n) -{ - while (l != NULL) - { - if (n <= l->noOfelements) - { - return l->elements.array[n-1]; - } - else - { - n -= l->noOfelements; - } - l = l->next; - } - return reinterpret_cast (0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getIndexOfList - returns the index for WORD, c, in list, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int lists_getIndexOfList (lists_list l, void * c) -{ - unsigned int i; - - if (l == NULL) - { - return 0; - } - else - { - i = 1; - while (i <= l->noOfelements) - { - if (l->elements.array[i-1] == c) - { - return i; - } - else - { - i += 1; - } - } - return l->noOfelements+(lists_getIndexOfList (l->next, c)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - noOfItemsInList - returns the number of items in list, l. -*/ - -extern "C" unsigned int lists_noOfItemsInList (lists_list l) -{ - unsigned int t; - - if (l == NULL) - { - return 0; - } - else - { - t = 0; - do { - t += l->noOfelements; - l = l->next; - } while (! (l == NULL)); - return t; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - includeItemIntoList - adds an ADDRESS, c, into a list providing - the value does not already exist. -*/ - -extern "C" void lists_includeItemIntoList (lists_list l, void * c) -{ - if (! (lists_isItemInList (l, c))) - { - lists_putItemIntoList (l, c); - } -} - - -/* - removeItemFromList - removes a ADDRESS, c, from a list. - It assumes that this value only appears once. -*/ - -extern "C" void lists_removeItemFromList (lists_list l, void * c) -{ - lists_list p; - unsigned int i; - unsigned int found; - - if (l != NULL) - { - found = FALSE; - p = NULL; - do { - i = 1; - while ((i <= l->noOfelements) && (l->elements.array[i-1] != c)) - { - i += 1; - } - if ((i <= l->noOfelements) && (l->elements.array[i-1] == c)) - { - found = TRUE; - } - else - { - p = l; - l = l->next; - } - } while (! ((l == NULL) || found)); - if (found) - { - removeItem (p, l, i); - } - } -} - - -/* - isItemInList - returns true if a ADDRESS, c, was found in list, l. -*/ - -extern "C" unsigned int lists_isItemInList (lists_list l, void * c) -{ - unsigned int i; - - do { - i = 1; - while (i <= l->noOfelements) - { - if (l->elements.array[i-1] == c) - { - return TRUE; - } - else - { - i += 1; - } - } - l = l->next; - } while (! (l == NULL)); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - foreachItemInListDo - calls procedure, P, foreach item in list, l. -*/ - -extern "C" void lists_foreachItemInListDo (lists_list l, symbolKey_performOperation p) -{ - unsigned int i; - unsigned int n; - - n = lists_noOfItemsInList (l); - i = 1; - while (i <= n) - { - (*p.proc) (lists_getItemFromList (l, i)); - i += 1; - } -} - - -/* - duplicateList - returns a duplicate list derived from, l. -*/ - -extern "C" lists_list lists_duplicateList (lists_list l) -{ - lists_list m; - unsigned int n; - unsigned int i; - - m = lists_initList (); - n = lists_noOfItemsInList (l); - i = 1; - while (i <= n) - { - lists_putItemIntoList (m, lists_getItemFromList (l, i)); - i += 1; - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_lists_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_lists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcComment.c b/gcc/m2/mc-boot/GmcComment.c deleted file mode 100644 index 2e60c7aa567b..000000000000 --- a/gcc/m2/mc-boot/GmcComment.c +++ /dev/null @@ -1,468 +0,0 @@ -/* do not edit automatically generated by mc from mcComment. */ -/* mcComment.mod provides a module to remember the comments. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcComment_H -#define _mcComment_C - -# include "GDynamicStrings.h" -# include "GStorage.h" -# include "GnameKey.h" -# include "GmcDebug.h" -# include "GASCII.h" -# include "Glibc.h" - -typedef struct mcComment__T1_r mcComment__T1; - -typedef enum {mcComment_unknown, mcComment_procedureHeading, mcComment_inBody, mcComment_afterStatement} mcComment_commentType; - -typedef mcComment__T1 *mcComment_commentDesc; - -struct mcComment__T1_r { - mcComment_commentType type; - DynamicStrings_String content; - nameKey_Name procName; - unsigned int used; - }; - - -/* - initComment - the start of a new comment has been seen by the lexical analyser. - A new comment block is created and all addText contents are placed - in this block. onlySpaces indicates whether we have only seen - spaces on this line. -*/ - -extern "C" mcComment_commentDesc mcComment_initComment (unsigned int onlySpaces); - -/* - addText - cs is a C string (null terminated) which contains comment text. - This is appended to the comment, cd. -*/ - -extern "C" void mcComment_addText (mcComment_commentDesc cd, void * cs); - -/* - getContent - returns the content of comment, cd. -*/ - -extern "C" DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd); - -/* - getCommentCharStar - returns the C string content of comment, cd. -*/ - -extern "C" void * mcComment_getCommentCharStar (mcComment_commentDesc cd); - -/* - setProcedureComment - changes the type of comment, cd, to a - procedure heading comment, - providing it has the procname as the first word. -*/ - -extern "C" void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname); - -/* - getProcedureComment - returns the current procedure comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd); - -/* - getAfterStatementComment - returns the current statement after comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd); - -/* - getInbodyStatementComment - returns the current statement after comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd); - -/* - isProcedureComment - returns TRUE if, cd, is a procedure comment. -*/ - -extern "C" unsigned int mcComment_isProcedureComment (mcComment_commentDesc cd); - -/* - isBodyComment - returns TRUE if, cd, is a body comment. -*/ - -extern "C" unsigned int mcComment_isBodyComment (mcComment_commentDesc cd); - -/* - isAfterComment - returns TRUE if, cd, is an after comment. -*/ - -extern "C" unsigned int mcComment_isAfterComment (mcComment_commentDesc cd); - -/* - Min - returns the lower of, a, and, b. -*/ - -static unsigned int Min (unsigned int a, unsigned int b); - -/* - RemoveNewlines - -*/ - -static DynamicStrings_String RemoveNewlines (DynamicStrings_String s); - -/* - seenProcedure - returns TRUE if the name, procName, appears as the first word - in the comment. -*/ - -static unsigned int seenProcedure (mcComment_commentDesc cd, nameKey_Name procName); - -/* - dumpComment - -*/ - -static void dumpComment (mcComment_commentDesc cd); - - -/* - Min - returns the lower of, a, and, b. -*/ - -static unsigned int Min (unsigned int a, unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveNewlines - -*/ - -static DynamicStrings_String RemoveNewlines (DynamicStrings_String s) -{ - while ((DynamicStrings_Length (s)) > 0) - { - if ((DynamicStrings_char (s, 0)) == ASCII_nl) - { - s = DynamicStrings_RemoveWhitePrefix (DynamicStrings_Slice (s, 1, 0)); - } - else - { - return DynamicStrings_RemoveWhitePrefix (s); - } - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - seenProcedure - returns TRUE if the name, procName, appears as the first word - in the comment. -*/ - -static unsigned int seenProcedure (mcComment_commentDesc cd, nameKey_Name procName) -{ - DynamicStrings_String s; - void * a; - unsigned int i; - unsigned int h; - unsigned int res; - - a = nameKey_keyToCharStar (procName); - s = RemoveNewlines (cd->content); - s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast (Min (DynamicStrings_Length (s), nameKey_lengthKey (procName)))); - res = DynamicStrings_EqualCharStar (s, a); - s = DynamicStrings_KillString (s); - return res; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dumpComment - -*/ - -static void dumpComment (mcComment_commentDesc cd) -{ - libc_printf ((const char *) "comment : ", 10); - switch (cd->type) - { - case mcComment_unknown: - libc_printf ((const char *) "unknown", 7); - break; - - case mcComment_procedureHeading: - libc_printf ((const char *) "procedureheading", 16); - break; - - case mcComment_inBody: - libc_printf ((const char *) "inbody", 6); - break; - - case mcComment_afterStatement: - libc_printf ((const char *) "afterstatement", 14); - break; - - - default: - CaseException ("../../gcc-read-write/gcc/m2/mc/mcComment.def", 20, 1); - __builtin_unreachable (); - } - if (cd->used) - { - libc_printf ((const char *) " used", 5); - } - else - { - libc_printf ((const char *) " unused", 7); - } - libc_printf ((const char *) " contents = %s\\n", 16, DynamicStrings_string (cd->content)); -} - - -/* - initComment - the start of a new comment has been seen by the lexical analyser. - A new comment block is created and all addText contents are placed - in this block. onlySpaces indicates whether we have only seen - spaces on this line. -*/ - -extern "C" mcComment_commentDesc mcComment_initComment (unsigned int onlySpaces) -{ - mcComment_commentDesc cd; - - Storage_ALLOCATE ((void **) &cd, sizeof (mcComment__T1)); - mcDebug_assert (cd != NULL); - if (onlySpaces) - { - cd->type = mcComment_inBody; - } - else - { - cd->type = mcComment_afterStatement; - } - cd->content = DynamicStrings_InitString ((const char *) "", 0); - cd->procName = nameKey_NulName; - cd->used = FALSE; - return cd; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addText - cs is a C string (null terminated) which contains comment text. - This is appended to the comment, cd. -*/ - -extern "C" void mcComment_addText (mcComment_commentDesc cd, void * cs) -{ - if (cd != NULL) - { - cd->content = DynamicStrings_ConCat (cd->content, DynamicStrings_InitStringCharStar (cs)); - } -} - - -/* - getContent - returns the content of comment, cd. -*/ - -extern "C" DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd) -{ - if (cd != NULL) - { - return cd->content; - } - return static_cast (NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getCommentCharStar - returns the C string content of comment, cd. -*/ - -extern "C" void * mcComment_getCommentCharStar (mcComment_commentDesc cd) -{ - DynamicStrings_String s; - - s = mcComment_getContent (cd); - if (s == NULL) - { - return NULL; - } - else - { - return DynamicStrings_string (s); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setProcedureComment - changes the type of comment, cd, to a - procedure heading comment, - providing it has the procname as the first word. -*/ - -extern "C" void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname) -{ - if (cd != NULL) - { - if (seenProcedure (cd, procname)) - { - cd->type = mcComment_procedureHeading; - cd->procName = procname; - } - } -} - - -/* - getProcedureComment - returns the current procedure comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd) -{ - if ((cd->type == mcComment_procedureHeading) && ! cd->used) - { - cd->used = TRUE; - return cd->content; - } - return static_cast (NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getAfterStatementComment - returns the current statement after comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd) -{ - if ((cd->type == mcComment_afterStatement) && ! cd->used) - { - cd->used = TRUE; - return cd->content; - } - return static_cast (NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getInbodyStatementComment - returns the current statement after comment if available. -*/ - -extern "C" DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd) -{ - if ((cd->type == mcComment_inBody) && ! cd->used) - { - cd->used = TRUE; - return cd->content; - } - return static_cast (NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isProcedureComment - returns TRUE if, cd, is a procedure comment. -*/ - -extern "C" unsigned int mcComment_isProcedureComment (mcComment_commentDesc cd) -{ - return (cd != NULL) && (cd->type == mcComment_procedureHeading); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isBodyComment - returns TRUE if, cd, is a body comment. -*/ - -extern "C" unsigned int mcComment_isBodyComment (mcComment_commentDesc cd) -{ - return (cd != NULL) && (cd->type == mcComment_inBody); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isAfterComment - returns TRUE if, cd, is an after comment. -*/ - -extern "C" unsigned int mcComment_isAfterComment (mcComment_commentDesc cd) -{ - return (cd != NULL) && (cd->type == mcComment_afterStatement); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcComment_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcComment_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcComp.c b/gcc/m2/mc-boot/GmcComp.c deleted file mode 100644 index 8a79413add4e..000000000000 --- a/gcc/m2/mc-boot/GmcComp.c +++ /dev/null @@ -1,660 +0,0 @@ -/* do not edit automatically generated by mc from mcComp. */ -/* Copyright (C) 2015-2023 Free Software Foundation, Inc. - This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcComp_H -#define _mcComp_C - -# include "GFIO.h" -# include "Glibc.h" -# include "Gdecl.h" -# include "GsymbolKey.h" -# include "GSYSTEM.h" -# include "GmcReserved.h" -# include "GmcSearch.h" -# include "GmcLexBuf.h" -# include "GmcFileName.h" -# include "GmcPreprocess.h" -# include "GFormatStrings.h" -# include "Gmcflex.h" -# include "Gmcp1.h" -# include "Gmcp2.h" -# include "Gmcp3.h" -# include "Gmcp4.h" -# include "Gmcp5.h" -# include "GmcComment.h" -# include "GmcError.h" -# include "GnameKey.h" -# include "GmcPrintf.h" -# include "GmcQuiet.h" -# include "GDynamicStrings.h" -# include "GmcOptions.h" - -# define Debugging FALSE -typedef struct mcComp_parserFunction_p mcComp_parserFunction; - -typedef struct mcComp_openFunction_p mcComp_openFunction; - -typedef unsigned int (*mcComp_parserFunction_t) (void); -struct mcComp_parserFunction_p { mcComp_parserFunction_t proc; }; - -typedef unsigned int (*mcComp_openFunction_t) (decl_node, unsigned int); -struct mcComp_openFunction_p { mcComp_openFunction_t proc; }; - -static unsigned int currentPass; - -/* - compile - check, s, is non NIL before calling doCompile. -*/ - -extern "C" void mcComp_compile (DynamicStrings_String s); - -/* - getPassNo - return the pass no. -*/ - -extern "C" unsigned int mcComp_getPassNo (void); - -/* - doCompile - translate file, s, using a 6 pass technique. -*/ - -static void doCompile (DynamicStrings_String s); - -/* - examineCompilationUnit - opens the source file to obtain the module name and kind of module. -*/ - -static decl_node examineCompilationUnit (void); - -/* - peepInto - peeps into source, s, and initializes a definition/implementation or - program module accordingly. -*/ - -static decl_node peepInto (DynamicStrings_String s); - -/* - initParser - returns the node of the module found in the source file. -*/ - -static decl_node initParser (DynamicStrings_String s); - -/* - p1 - wrap the pass procedure with the correct parameter values. -*/ - -static void p1 (decl_node n); - -/* - p2 - wrap the pass procedure with the correct parameter values. -*/ - -static void p2 (decl_node n); - -/* - p3 - wrap the pass procedure with the correct parameter values. -*/ - -static void p3 (decl_node n); - -/* - p4 - wrap the pass procedure with the correct parameter values. -*/ - -static void p4 (decl_node n); - -/* - p5 - wrap the pass procedure with the correct parameter values. -*/ - -static void p5 (decl_node n); - -/* - doOpen - -*/ - -static unsigned int doOpen (decl_node n, DynamicStrings_String symName, DynamicStrings_String fileName, unsigned int exitOnFailure); - -/* - openDef - try and open the definition module source file. - Returns true/false if successful/unsuccessful or - exitOnFailure. -*/ - -static unsigned int openDef (decl_node n, unsigned int exitOnFailure); - -/* - openMod - try and open the implementation/program module source file. - Returns true/false if successful/unsuccessful or - exitOnFailure. -*/ - -static unsigned int openMod (decl_node n, unsigned int exitOnFailure); - -/* - pass - -*/ - -static void pass (unsigned int no, decl_node n, mcComp_parserFunction f, decl_isNodeF isnode, mcComp_openFunction open); - -/* - doPass - -*/ - -static void doPass (unsigned int parseDefs, unsigned int parseMain, unsigned int no, symbolKey_performOperation p, const char *desc_, unsigned int _desc_high); - -/* - setToPassNo - -*/ - -static void setToPassNo (unsigned int n); - -/* - init - initialise data structures for this module. -*/ - -static void init (void); - - -/* - doCompile - translate file, s, using a 6 pass technique. -*/ - -static void doCompile (DynamicStrings_String s) -{ - decl_node n; - - n = initParser (s); - doPass (TRUE, TRUE, 1, (symbolKey_performOperation) {(symbolKey_performOperation_t) p1}, (const char *) "lexical analysis, modules, root decls and C preprocessor", 56); - doPass (TRUE, TRUE, 2, (symbolKey_performOperation) {(symbolKey_performOperation_t) p2}, (const char *) "[all modules] type equivalence and enumeration types", 52); - doPass (TRUE, TRUE, 3, (symbolKey_performOperation) {(symbolKey_performOperation_t) p3}, (const char *) "[all modules] import lists, types, variables and procedure declarations", 71); - doPass (TRUE, TRUE, 4, (symbolKey_performOperation) {(symbolKey_performOperation_t) p4}, (const char *) "[all modules] constant expressions", 34); - if (! (decl_isDef (n))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (decl_isImp (n)) - { - mcQuiet_qprintf0 ((const char *) "Parse implementation module\\n", 29); - doPass (FALSE, TRUE, 5, (symbolKey_performOperation) {(symbolKey_performOperation_t) p5}, (const char *) "[implementation module] build code tree for all procedures and module initializations", 85); - } - else - { - mcQuiet_qprintf0 ((const char *) "Parse program module\\n", 22); - doPass (FALSE, TRUE, 5, (symbolKey_performOperation) {(symbolKey_performOperation_t) p5}, (const char *) "[program module] build code tree for all procedures and module initializations", 78); - } - } - mcQuiet_qprintf0 ((const char *) "walk tree converting it to C/C++\\n", 34); - decl_out (); -} - - -/* - examineCompilationUnit - opens the source file to obtain the module name and kind of module. -*/ - -static decl_node examineCompilationUnit (void) -{ - /* stop if we see eof, ';' or '[' */ - while (((mcLexBuf_currenttoken != mcReserved_eoftok) && (mcLexBuf_currenttoken != mcReserved_semicolontok)) && (mcLexBuf_currenttoken != mcReserved_lsbratok)) - { - if (mcLexBuf_currenttoken == mcReserved_definitiontok) - { - mcLexBuf_getToken (); - if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (mcLexBuf_currenttoken == mcReserved_fortok) - { - mcLexBuf_getToken (); - if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - mcLexBuf_getToken (); - } - else - { - mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "expecting language string after FOR keyword", 43))); - libc_exit (1); - } - } - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - return decl_lookupDef (nameKey_makekey (mcLexBuf_currentstring)); - } - } - else - { - mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "MODULE missing after DEFINITION keyword", 39))); - } - } - else if (mcLexBuf_currenttoken == mcReserved_implementationtok) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - return decl_lookupImp (nameKey_makekey (mcLexBuf_currentstring)); - } - } - else - { - mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "MODULE missing after IMPLEMENTATION keyword", 43))); - } - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - return decl_lookupModule (nameKey_makekey (mcLexBuf_currentstring)); - } - } - mcLexBuf_getToken (); - } - mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "failed to find module name", 26))); - libc_exit (1); - ReturnException ("../../gcc-read-write/gcc/m2/mc/mcComp.def", 20, 1); - __builtin_unreachable (); -} - - -/* - peepInto - peeps into source, s, and initializes a definition/implementation or - program module accordingly. -*/ - -static decl_node peepInto (DynamicStrings_String s) -{ - decl_node n; - DynamicStrings_String fileName; - - fileName = mcPreprocess_preprocessModule (s); - if (mcLexBuf_openSource (fileName)) - { - n = examineCompilationUnit (); - decl_setSource (n, nameKey_makekey (DynamicStrings_string (fileName))); - decl_setMainModule (n); - mcLexBuf_closeSource (); - mcLexBuf_reInitialize (); - return n; - } - else - { - mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to open %s\\n", 19, (const unsigned char *) &s, (sizeof (s)-1)); - libc_exit (1); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/mcComp.def", 20, 1); - __builtin_unreachable (); -} - - -/* - initParser - returns the node of the module found in the source file. -*/ - -static decl_node initParser (DynamicStrings_String s) -{ - mcQuiet_qprintf1 ((const char *) "Compiling: %s\\n", 15, (const unsigned char *) &s, (sizeof (s)-1)); - return peepInto (s); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - p1 - wrap the pass procedure with the correct parameter values. -*/ - -static void p1 (decl_node n) -{ - if (decl_isDef (n)) - { - /* avoid dangling else. */ - pass (1, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp1_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isDef}, (mcComp_openFunction) {(mcComp_openFunction_t) openDef}); - if ((decl_hasHidden (n)) && (mcOptions_getExtendedOpaque ())) - { - pass (1, decl_lookupImp (decl_getSymName (n)), (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp1_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImp}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); - } - } - else - { - pass (1, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp1_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); - } -} - - -/* - p2 - wrap the pass procedure with the correct parameter values. -*/ - -static void p2 (decl_node n) -{ - if (decl_isDef (n)) - { - /* avoid dangling else. */ - pass (2, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp2_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isDef}, (mcComp_openFunction) {(mcComp_openFunction_t) openDef}); - if ((decl_hasHidden (n)) && (mcOptions_getExtendedOpaque ())) - { - pass (2, decl_lookupImp (decl_getSymName (n)), (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp2_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImp}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); - } - } - else - { - pass (2, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp2_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); - } -} - - -/* - p3 - wrap the pass procedure with the correct parameter values. -*/ - -static void p3 (decl_node n) -{ - if (decl_isDef (n)) - { - /* avoid dangling else. */ - pass (3, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp3_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isDef}, (mcComp_openFunction) {(mcComp_openFunction_t) openDef}); - if ((decl_hasHidden (n)) && (mcOptions_getExtendedOpaque ())) - { - pass (3, decl_lookupImp (decl_getSymName (n)), (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp3_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImp}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); - } - } - else - { - pass (3, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp3_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); - } -} - - -/* - p4 - wrap the pass procedure with the correct parameter values. -*/ - -static void p4 (decl_node n) -{ - if (decl_isDef (n)) - { - /* avoid dangling else. */ - pass (4, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp4_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isDef}, (mcComp_openFunction) {(mcComp_openFunction_t) openDef}); - if ((decl_hasHidden (n)) && (mcOptions_getExtendedOpaque ())) - { - pass (4, decl_lookupImp (decl_getSymName (n)), (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp4_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImp}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); - } - } - else - { - pass (4, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp4_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); - } -} - - -/* - p5 - wrap the pass procedure with the correct parameter values. -*/ - -static void p5 (decl_node n) -{ - pass (5, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp5_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod}); -} - - -/* - doOpen - -*/ - -static unsigned int doOpen (decl_node n, DynamicStrings_String symName, DynamicStrings_String fileName, unsigned int exitOnFailure) -{ - DynamicStrings_String postProcessed; - - mcQuiet_qprintf2 ((const char *) " Module %-20s : %s\\n", 22, (const unsigned char *) &symName, (sizeof (symName)-1), (const unsigned char *) &fileName, (sizeof (fileName)-1)); - postProcessed = mcPreprocess_preprocessModule (fileName); - decl_setSource (n, nameKey_makekey (DynamicStrings_string (postProcessed))); - decl_setCurrentModule (n); - if (mcLexBuf_openSource (postProcessed)) - { - return TRUE; - } - mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to open %s\\n", 19, (const unsigned char *) &fileName, (sizeof (fileName)-1)); - if (exitOnFailure) - { - libc_exit (1); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openDef - try and open the definition module source file. - Returns true/false if successful/unsuccessful or - exitOnFailure. -*/ - -static unsigned int openDef (decl_node n, unsigned int exitOnFailure) -{ - nameKey_Name sourceName; - DynamicStrings_String symName; - DynamicStrings_String fileName; - - sourceName = decl_getSource (n); - symName = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - if (sourceName == nameKey_NulName) - { - /* avoid dangling else. */ - if (! (mcSearch_findSourceDefFile (symName, &fileName))) - { - mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to find definition module %s.def\\n", 41, (const unsigned char *) &symName, (sizeof (symName)-1)); - if (exitOnFailure) - { - libc_exit (1); - } - } - } - else - { - fileName = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (sourceName)); - } - return doOpen (n, symName, fileName, exitOnFailure); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openMod - try and open the implementation/program module source file. - Returns true/false if successful/unsuccessful or - exitOnFailure. -*/ - -static unsigned int openMod (decl_node n, unsigned int exitOnFailure) -{ - nameKey_Name sourceName; - DynamicStrings_String symName; - DynamicStrings_String fileName; - - sourceName = decl_getSource (n); - symName = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); - if (sourceName == nameKey_NulName) - { - /* avoid dangling else. */ - if (! (mcSearch_findSourceModFile (symName, &fileName))) - { - if (decl_isImp (n)) - { - mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to find implementation module %s.mod\\n", 45, (const unsigned char *) &symName, (sizeof (symName)-1)); - } - else - { - mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to find program module %s.mod\\n", 38, (const unsigned char *) &symName, (sizeof (symName)-1)); - } - if (exitOnFailure) - { - libc_exit (1); - } - } - } - else - { - fileName = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (sourceName)); - } - return doOpen (n, symName, fileName, exitOnFailure); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - pass - -*/ - -static void pass (unsigned int no, decl_node n, mcComp_parserFunction f, decl_isNodeF isnode, mcComp_openFunction open) -{ - if (((*isnode.proc) (n)) && (! (decl_isVisited (n)))) - { - decl_setVisited (n); - if ((*open.proc) (n, TRUE)) - { - if (! ((*f.proc) ())) - { - mcError_writeFormat0 ((const char *) "compilation failed", 18); - mcLexBuf_closeSource (); - return ; - } - mcLexBuf_closeSource (); - } - } -} - - -/* - doPass - -*/ - -static void doPass (unsigned int parseDefs, unsigned int parseMain, unsigned int no, symbolKey_performOperation p, const char *desc_, unsigned int _desc_high) -{ - DynamicStrings_String descs; - char desc[_desc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (desc, desc_, _desc_high+1); - - setToPassNo (no); - descs = DynamicStrings_InitString ((const char *) desc, _desc_high); - mcQuiet_qprintf2 ((const char *) "Pass %d: %s\\n", 13, (const unsigned char *) &no, (sizeof (no)-1), (const unsigned char *) &descs, (sizeof (descs)-1)); - decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) decl_unsetVisited}); - decl_foreachModModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) decl_unsetVisited}); - if (parseMain) - { - decl_unsetVisited (decl_getMainModule ()); - if (parseDefs && (decl_isImp (decl_getMainModule ()))) - { - /* we need to parse the definition module of a corresponding implementation module. */ - (*p.proc) (reinterpret_cast (decl_lookupDef (decl_getSymName (decl_getMainModule ())))); - } - (*p.proc) (reinterpret_cast (decl_getMainModule ())); - } - if (parseDefs) - { - decl_foreachDefModuleDo (p); - } - mcError_flushWarnings (); - mcError_flushErrors (); - setToPassNo (0); -} - - -/* - setToPassNo - -*/ - -static void setToPassNo (unsigned int n) -{ - currentPass = n; -} - - -/* - init - initialise data structures for this module. -*/ - -static void init (void) -{ - setToPassNo (0); -} - - -/* - compile - check, s, is non NIL before calling doCompile. -*/ - -extern "C" void mcComp_compile (DynamicStrings_String s) -{ - if (s != NULL) - { - doCompile (s); - } -} - - -/* - getPassNo - return the pass no. -*/ - -extern "C" unsigned int mcComp_getPassNo (void) -{ - return currentPass; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcComp_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - init (); -} - -extern "C" void _M2_mcComp_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcDebug.c b/gcc/m2/mc-boot/GmcDebug.c deleted file mode 100644 index db45ae8ac87c..000000000000 --- a/gcc/m2/mc-boot/GmcDebug.c +++ /dev/null @@ -1,86 +0,0 @@ -/* do not edit automatically generated by mc from mcDebug. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _mcDebug_H -#define _mcDebug_C - -# include "GStrIO.h" -# include "GmcOptions.h" -# include "GmcError.h" - - -/* - assert - tests the boolean, q. If false then an error is reported - and the execution is terminated. -*/ - -extern "C" void mcDebug_assert (unsigned int q); - -/* - writeDebug - only writes a string if internal debugging is on. -*/ - -extern "C" void mcDebug_writeDebug (const char *a_, unsigned int _a_high); - - -/* - assert - tests the boolean, q. If false then an error is reported - and the execution is terminated. -*/ - -extern "C" void mcDebug_assert (unsigned int q) -{ - if (! q) - { - mcError_internalError ((const char *) "assert failed", 13, (const char *) "../../gcc-read-write/gcc/m2/mc/mcDebug.mod", 42, 35); - } -} - - -/* - writeDebug - only writes a string if internal debugging is on. -*/ - -extern "C" void mcDebug_writeDebug (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - if (mcOptions_getInternalDebugging ()) - { - StrIO_WriteString ((const char *) a, _a_high); - StrIO_WriteLn (); - } -} - -extern "C" void _M2_mcDebug_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcDebug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcError.c b/gcc/m2/mc-boot/GmcError.c deleted file mode 100644 index cf96ceb79bda..000000000000 --- a/gcc/m2/mc-boot/GmcError.c +++ /dev/null @@ -1,1197 +0,0 @@ -/* do not edit automatically generated by mc from mcError. */ -/* mcError.mod provides an interface between the string handling modules. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcError_H -#define _mcError_C - -# include "GASCII.h" -# include "GDynamicStrings.h" -# include "GFIO.h" -# include "GStrLib.h" -# include "GFormatStrings.h" -# include "GStorage.h" -# include "GM2RTS.h" -# include "GSYSTEM.h" -# include "GStdIO.h" -# include "GnameKey.h" -# include "GmcLexBuf.h" -# include "GmcPrintf.h" - -# define Debugging TRUE -# define DebugTrace FALSE -# define Xcode TRUE -typedef struct mcError__T2_r mcError__T2; - -typedef mcError__T2 *mcError_error; - -struct mcError__T2_r { - mcError_error parent; - mcError_error child; - mcError_error next; - unsigned int fatal; - DynamicStrings_String s; - unsigned int token; - }; - -static mcError_error head; -static unsigned int inInternal; - -/* - internalError - displays an internal error message together with the compiler source - file and line number. - This function is not buffered and is used when the compiler is about - to give up. -*/ - -extern "C" void mcError_internalError (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line); - -/* - writeFormat0 - displays the source module and line together - with the encapsulated format string. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat0 (const char *a_, unsigned int _a_high); - -/* - writeFormat1 - displays the source module and line together - with the encapsulated format string. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - writeFormat2 - displays the module and line together with the encapsulated - format strings. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); - -/* - writeFormat3 - displays the module and line together with the encapsulated - format strings. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); - -/* - newError - creates and returns a new error handle. -*/ - -extern "C" mcError_error mcError_newError (unsigned int atTokenNo); - -/* - newWarning - creates and returns a new error handle suitable for a warning. - A warning will not stop compilation. -*/ - -extern "C" mcError_error mcError_newWarning (unsigned int atTokenNo); - -/* - chainError - creates and returns a new error handle, this new error - is associated with, e, and is chained onto the end of, e. - If, e, is NIL then the result to NewError is returned. -*/ - -extern "C" mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e); -extern "C" void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high); -extern "C" void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); -extern "C" void mcError_errorFormat2 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); -extern "C" void mcError_errorFormat3 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); -extern "C" void mcError_errorString (mcError_error e, DynamicStrings_String str); - -/* - errorStringAt - given an error string, s, it places this - string at token position, tok. - The string is consumed. -*/ - -extern "C" void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok); - -/* - errorStringAt2 - given an error string, s, it places this - string at token positions, tok1 and tok2, respectively. - The string is consumed. -*/ - -extern "C" void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2); - -/* - errorStringsAt2 - given error strings, s1, and, s2, it places these - strings at token positions, tok1 and tok2, respectively. - Both strings are consumed. -*/ - -extern "C" void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2); - -/* - warnStringAt - given an error string, s, it places this - string at token position, tok. - The string is consumed. -*/ - -extern "C" void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok); - -/* - warnStringAt2 - given an warning string, s, it places this - string at token positions, tok1 and tok2, respectively. - The string is consumed. -*/ - -extern "C" void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2); - -/* - warnStringsAt2 - given warning strings, s1, and, s2, it places these - strings at token positions, tok1 and tok2, respectively. - Both strings are consumed. -*/ - -extern "C" void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2); -extern "C" void mcError_warnFormat0 (const char *a_, unsigned int _a_high); - -/* - warnFormat1 - displays the source module and line together - with the encapsulated format string. - Used for simple warning messages tied to the current token. -*/ - -extern "C" void mcError_warnFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - flushErrors - switches the output channel to the error channel - and then writes out all errors. -*/ - -extern "C" void mcError_flushErrors (void); - -/* - flushWarnings - switches the output channel to the error channel - and then writes out all warnings. - If an error is present the compilation is terminated, - if warnings only were emitted then compilation will - continue. -*/ - -extern "C" void mcError_flushWarnings (void); - -/* - errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting. -*/ - -extern "C" void mcError_errorAbort0 (const char *a_, unsigned int _a_high); - -/* - cast - casts a := b -*/ - -static void cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high); -static unsigned int translateNameToCharStar (char *a, unsigned int _a_high, unsigned int n); - -/* - outString - writes the contents of String to stdout. - The string, s, is destroyed. -*/ - -static void outString (DynamicStrings_String file, unsigned int line, unsigned int col, DynamicStrings_String s); -static DynamicStrings_String doFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - doFormat2 - -*/ - -static DynamicStrings_String doFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); - -/* - writeFormat2 - displays the module and line together with the encapsulated - format strings. - Used for simple error messages tied to the current token. -*/ - -static DynamicStrings_String doFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); - -/* - init - initializes the error list. -*/ - -static void init (void); - -/* - checkIncludes - generates a sequence of error messages which determine the relevant - included file and line number. - For example: - - gcc a.c - In file included from b.h:1, - from a.c:1: - c.h:1: parse error before `and' - - where a.c is: #include "b.h" - b.h is: #include "c.h" - c.h is: and this and that - - we attempt to follow the error messages that gcc issues. -*/ - -static void checkIncludes (unsigned int token, unsigned int depth); - -/* - flushAll - flushes all errors in list, e. -*/ - -static unsigned int flushAll (mcError_error e, unsigned int FatalStatus); - - -/* - cast - casts a := b -*/ - -static void cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (b, b_, _b_high+1); - - if (_a_high == _b_high) - { - for (i=0; i<=_a_high; i++) - { - a[i] = b[i]; - } - } -} - -static unsigned int translateNameToCharStar (char *a, unsigned int _a_high, unsigned int n) -{ - unsigned int argno; - unsigned int i; - unsigned int h; - - /* - translateNameToString - takes a format specification string, a, and - if they consist of of %a then this is translated - into a String and %a is replaced by %s. - */ - argno = 1; - i = 0; - h = StrLib_StrLen ((const char *) a, _a_high); - while (i < h) - { - if ((a[i] == '%') && ((i+1) < h)) - { - if ((a[i+1] == 'a') && (argno == n)) - { - a[i+1] = 's'; - return TRUE; - } - argno += 1; - if (argno > n) - { - /* all done */ - return FALSE; - } - } - i += 1; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - outString - writes the contents of String to stdout. - The string, s, is destroyed. -*/ - -static void outString (DynamicStrings_String file, unsigned int line, unsigned int col, DynamicStrings_String s) -{ - typedef char *outString__T1; - - DynamicStrings_String leader; - outString__T1 p; - outString__T1 q; - unsigned int space; - unsigned int newline; - - col += 1; - if (Xcode) - { - leader = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%s:%d:", 6)), (const unsigned char *) &file, (sizeof (file)-1), (const unsigned char *) &line, (sizeof (line)-1)); - } - else - { - leader = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%s:%d:%d:", 9)), (const unsigned char *) &file, (sizeof (file)-1), (const unsigned char *) &line, (sizeof (line)-1), (const unsigned char *) &col, (sizeof (col)-1)); - } - p = static_cast (DynamicStrings_string (s)); - newline = TRUE; - space = FALSE; - while ((p != NULL) && ((*p) != ASCII_nul)) - { - if (newline) - { - q = static_cast (DynamicStrings_string (leader)); - while ((q != NULL) && ((*q) != ASCII_nul)) - { - StdIO_Write ((*q)); - q += 1; - } - } - newline = (*p) == ASCII_nl; - space = (*p) == ' '; - if (newline && Xcode) - { - mcPrintf_printf1 ((const char *) "(pos: %d)", 9, (const unsigned char *) &col, (sizeof (col)-1)); - } - StdIO_Write ((*p)); - p += 1; - } - if (! newline) - { - if (Xcode) - { - if (! space) - { - StdIO_Write (' '); - } - mcPrintf_printf1 ((const char *) "(pos: %d)", 9, (const unsigned char *) &col, (sizeof (col)-1)); - } - StdIO_Write (ASCII_nl); - } - FIO_FlushBuffer (FIO_StdOut); - if (! Debugging) - { - s = DynamicStrings_KillString (s); - leader = DynamicStrings_KillString (leader); - } -} - -static DynamicStrings_String doFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - DynamicStrings_String s; - nameKey_Name n; - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - /* - DoFormat1 - - */ - if (translateNameToCharStar ((char *) a, _a_high, 1)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w, _w_high); - s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s, (sizeof (s)-1)); - } - else - { - s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w, _w_high); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doFormat2 - -*/ - -static DynamicStrings_String doFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - nameKey_Name n; - DynamicStrings_String s; - DynamicStrings_String s1; - DynamicStrings_String s2; - unsigned int b; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - b = (unsigned int) 0; - if (translateNameToCharStar ((char *) a, _a_high, 1)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high); - s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (1 )); - } - if (translateNameToCharStar ((char *) a, _a_high, 2)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high); - s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (2 )); - } - switch (b) - { - case (unsigned int) 0: - s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high); - break; - - case (unsigned int) ((1 << (1))): - s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high); - break; - - case (unsigned int) ((1 << (2))): - s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2))): - s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1)); - break; - - - default: - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - writeFormat2 - displays the module and line together with the encapsulated - format strings. - Used for simple error messages tied to the current token. -*/ - -static DynamicStrings_String doFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high) -{ - nameKey_Name n; - DynamicStrings_String s; - DynamicStrings_String s1; - DynamicStrings_String s2; - DynamicStrings_String s3; - unsigned int b; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - - b = (unsigned int) 0; - if (translateNameToCharStar ((char *) a, _a_high, 1)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high); - s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (1 )); - } - if (translateNameToCharStar ((char *) a, _a_high, 2)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high); - s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (2 )); - } - if (translateNameToCharStar ((char *) a, _a_high, 3)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w3, _w3_high); - s3 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (3 )); - } - switch (b) - { - case (unsigned int) 0: - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high); - break; - - case (unsigned int) ((1 << (1))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high); - break; - - case (unsigned int) ((1 << (2))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high); - break; - - case (unsigned int) ((1 << (3))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (3))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1)); - break; - - case (unsigned int) ((1 << (2)) | (1 << (3))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (3))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1)); - break; - - - default: - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - init - initializes the error list. -*/ - -static void init (void) -{ - head = NULL; - inInternal = FALSE; -} - - -/* - checkIncludes - generates a sequence of error messages which determine the relevant - included file and line number. - For example: - - gcc a.c - In file included from b.h:1, - from a.c:1: - c.h:1: parse error before `and' - - where a.c is: #include "b.h" - b.h is: #include "c.h" - c.h is: and this and that - - we attempt to follow the error messages that gcc issues. -*/ - -static void checkIncludes (unsigned int token, unsigned int depth) -{ - DynamicStrings_String included; - unsigned int lineno; - - included = mcLexBuf_findFileNameFromToken (token, depth+1); - if (included != NULL) - { - lineno = mcLexBuf_tokenToLineNo (token, depth+1); - if (depth == 0) - { - mcPrintf_printf2 ((const char *) "In file included from %s:%d", 27, (const unsigned char *) &included, (sizeof (included)-1), (const unsigned char *) &lineno, (sizeof (lineno)-1)); - } - else - { - mcPrintf_printf2 ((const char *) " from %s:%d", 27, (const unsigned char *) &included, (sizeof (included)-1), (const unsigned char *) &lineno, (sizeof (lineno)-1)); - } - if ((mcLexBuf_findFileNameFromToken (token, depth+2)) == NULL) - { - mcPrintf_printf0 ((const char *) ":\\n", 3); - } - else - { - mcPrintf_printf0 ((const char *) ",\\n", 3); - } - checkIncludes (token, depth+1); - } -} - - -/* - flushAll - flushes all errors in list, e. -*/ - -static unsigned int flushAll (mcError_error e, unsigned int FatalStatus) -{ - mcError_error f; - unsigned int written; - - written = FALSE; - if (e != NULL) - { - do { - if ((FatalStatus == e->fatal) && (e->s != NULL)) - { - checkIncludes (e->token, 0); - if (e->fatal) - { - e->s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " error: ", 8), DynamicStrings_Mark (e->s)); - } - else - { - e->s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " warning: ", 10), DynamicStrings_Mark (e->s)); - } - outString (mcLexBuf_findFileNameFromToken (e->token, 0), mcLexBuf_tokenToLineNo (e->token, 0), mcLexBuf_tokenToColumnNo (e->token, 0), e->s); - if ((e->child != NULL) && (flushAll (e->child, FatalStatus))) - {} /* empty. */ - e->s = static_cast (NULL); - written = TRUE; - } - f = e; - e = e->next; - if (! Debugging) - { - f->s = DynamicStrings_KillString (f->s); - Storage_DEALLOCATE ((void **) &f, sizeof (mcError__T2)); - } - } while (! (e == NULL)); - } - return written; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - internalError - displays an internal error message together with the compiler source - file and line number. - This function is not buffered and is used when the compiler is about - to give up. -*/ - -extern "C" void mcError_internalError (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line) -{ - char a[_a_high+1]; - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (file, file_, _file_high+1); - - M2RTS_ExitOnHalt (1); - if (! inInternal) - { - inInternal = TRUE; - mcError_flushErrors (); - outString (mcLexBuf_findFileNameFromToken (mcLexBuf_getTokenNo (), 0), mcLexBuf_tokenToLineNo (mcLexBuf_getTokenNo (), 0), mcLexBuf_tokenToColumnNo (mcLexBuf_getTokenNo (), 0), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*** fatal error ***", 19))); - } - outString (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) file, _file_high)), line, 0, DynamicStrings_ConCat (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*** internal error *** ", 23)), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)))); - M2RTS_HALT (-1); - __builtin_unreachable (); -} - - -/* - writeFormat0 - displays the source module and line together - with the encapsulated format string. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat0 (const char *a_, unsigned int _a_high) -{ - mcError_error e; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - e = mcError_newError (mcLexBuf_getTokenNo ()); - e->s = FormatStrings_Sprintf0 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high))); -} - - -/* - writeFormat1 - displays the source module and line together - with the encapsulated format string. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - mcError_error e; - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - e = mcError_newError (mcLexBuf_getTokenNo ()); - e->s = doFormat1 ((const char *) a, _a_high, (const unsigned char *) w, _w_high); -} - - -/* - writeFormat2 - displays the module and line together with the encapsulated - format strings. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - mcError_error e; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - e = mcError_newError (mcLexBuf_getTokenNo ()); - e->s = doFormat2 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high); -} - - -/* - writeFormat3 - displays the module and line together with the encapsulated - format strings. - Used for simple error messages tied to the current token. -*/ - -extern "C" void mcError_writeFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high) -{ - mcError_error e; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - - e = mcError_newError (mcLexBuf_getTokenNo ()); - e->s = doFormat3 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high); -} - - -/* - newError - creates and returns a new error handle. -*/ - -extern "C" mcError_error mcError_newError (unsigned int atTokenNo) -{ - mcError_error e; - mcError_error f; - - Storage_ALLOCATE ((void **) &e, sizeof (mcError__T2)); - e->s = static_cast (NULL); - e->token = atTokenNo; - e->next = NULL; - e->parent = NULL; - e->child = NULL; - e->fatal = TRUE; - if ((head == NULL) || (head->token > atTokenNo)) - { - e->next = head; - head = e; - } - else - { - f = head; - while ((f->next != NULL) && (f->next->token < atTokenNo)) - { - f = f->next; - } - e->next = f->next; - f->next = e; - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - newWarning - creates and returns a new error handle suitable for a warning. - A warning will not stop compilation. -*/ - -extern "C" mcError_error mcError_newWarning (unsigned int atTokenNo) -{ - mcError_error e; - - e = mcError_newError (atTokenNo); - e->fatal = FALSE; - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - chainError - creates and returns a new error handle, this new error - is associated with, e, and is chained onto the end of, e. - If, e, is NIL then the result to NewError is returned. -*/ - -extern "C" mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e) -{ - mcError_error f; - - if (e == NULL) - { - return mcError_newError (atTokenNo); - } - else - { - Storage_ALLOCATE ((void **) &f, sizeof (mcError__T2)); - f->s = static_cast (NULL); - f->token = atTokenNo; - f->next = e->child; - f->parent = e; - f->child = NULL; - f->fatal = e->fatal; - e->child = f; - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - /* - errorFormat routines provide a printf capability for the error handle. - */ - if (e->s == NULL) - { - e->s = FormatStrings_Sprintf0 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high))); - } - else - { - e->s = DynamicStrings_ConCat (e->s, DynamicStrings_Mark (FormatStrings_Sprintf0 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high))))); - } -} - -extern "C" void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - DynamicStrings_String s1; - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - s1 = doFormat1 ((const char *) a, _a_high, (const unsigned char *) w, _w_high); - if (e->s == NULL) - { - e->s = s1; - } - else - { - e->s = DynamicStrings_ConCat (e->s, DynamicStrings_Mark (s1)); - } -} - -extern "C" void mcError_errorFormat2 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - DynamicStrings_String s1; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - s1 = doFormat2 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high); - if (e->s == NULL) - { - e->s = s1; - } - else - { - e->s = DynamicStrings_ConCat (e->s, DynamicStrings_Mark (s1)); - } -} - -extern "C" void mcError_errorFormat3 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high) -{ - DynamicStrings_String s1; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - - s1 = doFormat3 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high); - if (e->s == NULL) - { - e->s = s1; - } - else - { - e->s = DynamicStrings_ConCat (e->s, DynamicStrings_Mark (s1)); - } -} - -extern "C" void mcError_errorString (mcError_error e, DynamicStrings_String str) -{ - e->s = str; -} - - -/* - errorStringAt - given an error string, s, it places this - string at token position, tok. - The string is consumed. -*/ - -extern "C" void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok) -{ - mcError_error e; - - e = mcError_newError (tok); - mcError_errorString (e, s); -} - - -/* - errorStringAt2 - given an error string, s, it places this - string at token positions, tok1 and tok2, respectively. - The string is consumed. -*/ - -extern "C" void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2) -{ - mcError_errorStringsAt2 (s, s, tok1, tok2); -} - - -/* - errorStringsAt2 - given error strings, s1, and, s2, it places these - strings at token positions, tok1 and tok2, respectively. - Both strings are consumed. -*/ - -extern "C" void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2) -{ - mcError_error e; - - if (s1 == s2) - { - s2 = DynamicStrings_Dup (s1); - } - e = mcError_newError (tok1); - mcError_errorString (e, s1); - mcError_errorString (mcError_chainError (tok2, e), s2); -} - - -/* - warnStringAt - given an error string, s, it places this - string at token position, tok. - The string is consumed. -*/ - -extern "C" void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok) -{ - mcError_error e; - - e = mcError_newWarning (tok); - mcError_errorString (e, s); -} - - -/* - warnStringAt2 - given an warning string, s, it places this - string at token positions, tok1 and tok2, respectively. - The string is consumed. -*/ - -extern "C" void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2) -{ - mcError_warnStringsAt2 (s, s, tok1, tok2); -} - - -/* - warnStringsAt2 - given warning strings, s1, and, s2, it places these - strings at token positions, tok1 and tok2, respectively. - Both strings are consumed. -*/ - -extern "C" void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2) -{ - mcError_error e; - - if (s1 == s2) - { - s2 = DynamicStrings_Dup (s1); - } - e = mcError_newWarning (tok1); - mcError_errorString (e, s1); - mcError_errorString (mcError_chainError (tok2, e), s2); -} - -extern "C" void mcError_warnFormat0 (const char *a_, unsigned int _a_high) -{ - mcError_error e; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - /* - WarnFormat0 - displays the source module and line together - with the encapsulated format string. - Used for simple warning messages tied to the current token. - */ - e = mcError_newWarning (mcLexBuf_getTokenNo ()); - e->s = FormatStrings_Sprintf0 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high))); -} - - -/* - warnFormat1 - displays the source module and line together - with the encapsulated format string. - Used for simple warning messages tied to the current token. -*/ - -extern "C" void mcError_warnFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - mcError_error e; - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - e = mcError_newWarning (mcLexBuf_getTokenNo ()); - e->s = doFormat1 ((const char *) a, _a_high, (const unsigned char *) w, _w_high); -} - - -/* - flushErrors - switches the output channel to the error channel - and then writes out all errors. -*/ - -extern "C" void mcError_flushErrors (void) -{ - if (DebugTrace) - { - mcPrintf_printf0 ((const char *) "\\nFlushing all errors\\n", 23); - mcPrintf_printf0 ((const char *) "===================\\n", 21); - } - if (flushAll (head, TRUE)) - { - M2RTS_ExitOnHalt (1); - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - flushWarnings - switches the output channel to the error channel - and then writes out all warnings. - If an error is present the compilation is terminated, - if warnings only were emitted then compilation will - continue. -*/ - -extern "C" void mcError_flushWarnings (void) -{ - if (flushAll (head, FALSE)) - {} /* empty. */ -} - - -/* - errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting. -*/ - -extern "C" void mcError_errorAbort0 (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - mcError_flushWarnings (); - if (! (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "", 0))) - { - mcError_writeFormat0 ((const char *) a, _a_high); - } - if (! (flushAll (head, TRUE))) - { - mcError_writeFormat0 ((const char *) "unidentified error", 18); - if (flushAll (head, TRUE)) - {} /* empty. */ - } - M2RTS_ExitOnHalt (1); - M2RTS_HALT (-1); - __builtin_unreachable (); -} - -extern "C" void _M2_mcError_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - init (); -} - -extern "C" void _M2_mcError_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcFileName.c b/gcc/m2/mc-boot/GmcFileName.c deleted file mode 100644 index 3413d8949d37..000000000000 --- a/gcc/m2/mc-boot/GmcFileName.c +++ /dev/null @@ -1,152 +0,0 @@ -/* do not edit automatically generated by mc from mcFileName. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _mcFileName_H -#define _mcFileName_C - -# include "GASCII.h" -# include "GDynamicStrings.h" - -# define MaxFileName 0 -# define MaxStemName 0 -# define Directory '/' - -/* - calculateFileName - calculates and returns a new string filename given a module - and an extension. String, Extension, is concatenated onto - Module and thus it is safe to `Mark' the extension for garbage - collection. -*/ - -extern "C" DynamicStrings_String mcFileName_calculateFileName (DynamicStrings_String module, DynamicStrings_String extension); - -/* - calculateStemName - calculates the stem name for given a module. - This name length will be operating system and - compiler specific. -*/ - -extern "C" DynamicStrings_String mcFileName_calculateStemName (DynamicStrings_String module); - -/* - extractExtension - given a, filename, return the filename without - the extension, Ext. -*/ - -extern "C" DynamicStrings_String mcFileName_extractExtension (DynamicStrings_String filename, DynamicStrings_String ext); - -/* - extractModule - given a, filename, return the module name including any - extension. A new string is returned. -*/ - -extern "C" DynamicStrings_String mcFileName_extractModule (DynamicStrings_String filename); - - -/* - calculateFileName - calculates and returns a new string filename given a module - and an extension. String, Extension, is concatenated onto - Module and thus it is safe to `Mark' the extension for garbage - collection. -*/ - -extern "C" DynamicStrings_String mcFileName_calculateFileName (DynamicStrings_String module, DynamicStrings_String extension) -{ - if (MaxFileName == 0) - { - return DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (module, 0, MaxFileName), '.'), extension); - } - else - { - return DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (module, 0, (MaxFileName-(DynamicStrings_Length (extension)))-1), '.'), extension); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - calculateStemName - calculates the stem name for given a module. - This name length will be operating system and - compiler specific. -*/ - -extern "C" DynamicStrings_String mcFileName_calculateStemName (DynamicStrings_String module) -{ - return DynamicStrings_Slice (module, 0, MaxStemName); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - extractExtension - given a, filename, return the filename without - the extension, Ext. -*/ - -extern "C" DynamicStrings_String mcFileName_extractExtension (DynamicStrings_String filename, DynamicStrings_String ext) -{ - if (DynamicStrings_Equal (ext, DynamicStrings_Mark (DynamicStrings_Slice (filename, static_cast (-(DynamicStrings_Length (ext))), 0)))) - { - return DynamicStrings_Slice (filename, 0, static_cast (-(DynamicStrings_Length (ext)))); - } - else - { - return filename; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - extractModule - given a, filename, return the module name including any - extension. A new string is returned. -*/ - -extern "C" DynamicStrings_String mcFileName_extractModule (DynamicStrings_String filename) -{ - int i; - - i = DynamicStrings_Index (filename, Directory, 0); - if (i == -1) - { - return DynamicStrings_Dup (filename); - } - else - { - return DynamicStrings_Slice (filename, i+1, 0); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcFileName_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcFileName_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcLexBuf.c b/gcc/m2/mc-boot/GmcLexBuf.c deleted file mode 100644 index d310e87929df..000000000000 --- a/gcc/m2/mc-boot/GmcLexBuf.c +++ /dev/null @@ -1,1849 +0,0 @@ -/* do not edit automatically generated by mc from mcLexBuf. */ -/* mcLexBuf.mod provides a buffer for the all the tokens created by m2.lex. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcLexBuf_H -#define _mcLexBuf_C - -# include "Gmcflex.h" -# include "Glibc.h" -# include "GSYSTEM.h" -# include "GStorage.h" -# include "GDynamicStrings.h" -# include "GFormatStrings.h" -# include "GnameKey.h" -# include "GmcReserved.h" -# include "GmcComment.h" -# include "GmcPrintf.h" -# include "GmcDebug.h" -# include "GM2RTS.h" - -mcComment_commentDesc mcLexBuf_currentcomment; -mcComment_commentDesc mcLexBuf_lastcomment; -int mcLexBuf_currentinteger; -unsigned int mcLexBuf_currentcolumn; -void * mcLexBuf_currentstring; -mcReserved_toktype mcLexBuf_currenttoken; -# define MaxBucketSize 100 -# define Debugging FALSE -typedef struct mcLexBuf_tokenDesc_r mcLexBuf_tokenDesc; - -typedef struct mcLexBuf_listDesc_r mcLexBuf_listDesc; - -typedef struct mcLexBuf__T1_r mcLexBuf__T1; - -typedef mcLexBuf__T1 *mcLexBuf_sourceList; - -typedef struct mcLexBuf__T2_r mcLexBuf__T2; - -typedef mcLexBuf__T2 *mcLexBuf_tokenBucket; - -typedef struct mcLexBuf__T3_a mcLexBuf__T3; - -struct mcLexBuf_tokenDesc_r { - mcReserved_toktype token; - nameKey_Name str; - int int_; - mcComment_commentDesc com; - unsigned int line; - unsigned int col; - mcLexBuf_sourceList file; - }; - -struct mcLexBuf_listDesc_r { - mcLexBuf_tokenBucket head; - mcLexBuf_tokenBucket tail; - unsigned int lastBucketOffset; - }; - -struct mcLexBuf__T1_r { - mcLexBuf_sourceList left; - mcLexBuf_sourceList right; - DynamicStrings_String name; - unsigned int line; - unsigned int col; - }; - -struct mcLexBuf__T3_a { mcLexBuf_tokenDesc array[MaxBucketSize+1]; }; -struct mcLexBuf__T2_r { - mcLexBuf__T3 buf; - unsigned int len; - mcLexBuf_tokenBucket next; - }; - -static mcComment_commentDesc procedureComment; -static mcComment_commentDesc bodyComment; -static mcComment_commentDesc afterComment; -static mcLexBuf_sourceList currentSource; -static unsigned int useBufferedTokens; -static unsigned int currentUsed; -static mcLexBuf_listDesc listOfTokens; -static unsigned int nextTokNo; - -/* - getProcedureComment - returns the procedure comment if it exists, - or NIL otherwise. -*/ - -extern "C" mcComment_commentDesc mcLexBuf_getProcedureComment (void); - -/* - getBodyComment - returns the body comment if it exists, - or NIL otherwise. The body comment is - removed if found. -*/ - -extern "C" mcComment_commentDesc mcLexBuf_getBodyComment (void); - -/* - getAfterComment - returns the after comment if it exists, - or NIL otherwise. The after comment is - removed if found. -*/ - -extern "C" mcComment_commentDesc mcLexBuf_getAfterComment (void); - -/* - openSource - attempts to open the source file, s. - The success of the operation is returned. -*/ - -extern "C" unsigned int mcLexBuf_openSource (DynamicStrings_String s); - -/* - closeSource - closes the current open file. -*/ - -extern "C" void mcLexBuf_closeSource (void); - -/* - reInitialize - re-initialize the all the data structures. -*/ - -extern "C" void mcLexBuf_reInitialize (void); - -/* - resetForNewPass - reset the buffer pointers to the beginning ready for - a new pass -*/ - -extern "C" void mcLexBuf_resetForNewPass (void); - -/* - getToken - gets the next token into currenttoken. -*/ - -extern "C" void mcLexBuf_getToken (void); - -/* - insertToken - inserts a symbol, token, infront of the current token - ready for the next pass. -*/ - -extern "C" void mcLexBuf_insertToken (mcReserved_toktype token); - -/* - insertTokenAndRewind - inserts a symbol, token, infront of the current token - and then moves the token stream back onto the inserted token. -*/ - -extern "C" void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token); - -/* - getPreviousTokenLineNo - returns the line number of the previous token. -*/ - -extern "C" unsigned int mcLexBuf_getPreviousTokenLineNo (void); - -/* - getLineNo - returns the current line number where the symbol occurs in - the source file. -*/ - -extern "C" unsigned int mcLexBuf_getLineNo (void); - -/* - getTokenNo - returns the current token number. -*/ - -extern "C" unsigned int mcLexBuf_getTokenNo (void); - -/* - tokenToLineNo - returns the line number of the current file for the - tokenNo. The depth refers to the include depth. - A depth of 0 is the current file, depth of 1 is the file - which included the current file. Zero is returned if the - depth exceeds the file nesting level. -*/ - -extern "C" unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth); - -/* - getColumnNo - returns the current column where the symbol occurs in - the source file. -*/ - -extern "C" unsigned int mcLexBuf_getColumnNo (void); - -/* - tokenToColumnNo - returns the column number of the current file for the - tokenNo. The depth refers to the include depth. - A depth of 0 is the current file, depth of 1 is the file - which included the current file. Zero is returned if the - depth exceeds the file nesting level. -*/ - -extern "C" unsigned int mcLexBuf_tokenToColumnNo (unsigned int tokenNo, unsigned int depth); - -/* - findFileNameFromToken - returns the complete FileName for the appropriate - source file yields the token number, tokenNo. - The, Depth, indicates the include level: 0..n - Level 0 is the current. NIL is returned if n+1 - is requested. -*/ - -extern "C" DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth); - -/* - getFileName - returns a String defining the current file. -*/ - -extern "C" DynamicStrings_String mcLexBuf_getFileName (void); - -/* - addTok - adds a token to the buffer. -*/ - -extern "C" void mcLexBuf_addTok (mcReserved_toktype t); - -/* - addTokCharStar - adds a token to the buffer and an additional string, s. - A copy of string, s, is made. -*/ - -extern "C" void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s); - -/* - addTokInteger - adds a token and an integer to the buffer. -*/ - -extern "C" void mcLexBuf_addTokInteger (mcReserved_toktype t, int i); - -/* - addTokComment - adds a token to the buffer and a comment descriptor, com. -*/ - -extern "C" void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com); - -/* - setFile - sets the current filename to, filename. -*/ - -extern "C" void mcLexBuf_setFile (void * filename); - -/* - pushFile - indicates that, filename, has just been included. -*/ - -extern "C" void mcLexBuf_pushFile (void * filename); - -/* - popFile - indicates that we are returning to, filename, having finished - an include. -*/ - -extern "C" void mcLexBuf_popFile (void * filename); - -/* - debugLex - display the last, n, tokens. -*/ - -static void debugLex (unsigned int n); - -/* - seekTo - -*/ - -static void seekTo (unsigned int t); - -/* - peeptokenBucket - -*/ - -static mcLexBuf_tokenBucket peeptokenBucket (unsigned int *t); - -/* - peepAfterComment - peeps ahead looking for an after statement comment. It stops at an END token - or if the line number changes. -*/ - -static void peepAfterComment (void); - -/* - init - initializes the token list and source list. -*/ - -static void init (void); - -/* - addTo - adds a new element to the end of sourceList, currentSource. -*/ - -static void addTo (mcLexBuf_sourceList l); - -/* - subFrom - subtracts, l, from the source list. -*/ - -static void subFrom (mcLexBuf_sourceList l); - -/* - newElement - returns a new sourceList -*/ - -static mcLexBuf_sourceList newElement (void * s); - -/* - newList - initializes an empty list with the classic dummy header element. -*/ - -static mcLexBuf_sourceList newList (void); - -/* - checkIfNeedToDuplicate - checks to see whether the currentSource has - been used, if it has then duplicate the list. -*/ - -static void checkIfNeedToDuplicate (void); - -/* - killList - kills the sourceList providing that it has not been used. -*/ - -static void killList (void); - -/* - displayToken - -*/ - -static void displayToken (mcReserved_toktype t); - -/* - updateFromBucket - updates the global variables: currenttoken, - currentstring, currentcolumn and currentinteger - from tokenBucket, b, and, offset. -*/ - -static void updateFromBucket (mcLexBuf_tokenBucket b, unsigned int offset); - -/* - doGetToken - fetch the next token into currenttoken. -*/ - -static void doGetToken (void); - -/* - syncOpenWithBuffer - synchronise the buffer with the start of a file. - Skips all the tokens to do with the previous file. -*/ - -static void syncOpenWithBuffer (void); - -/* - findtokenBucket - returns the tokenBucket corresponding to the tokenNo. -*/ - -static mcLexBuf_tokenBucket findtokenBucket (unsigned int *tokenNo); - -/* - getFileName - returns a String defining the current file. -*/ - -static void stop (void); - -/* - addTokToList - adds a token to a dynamic list. -*/ - -static void addTokToList (mcReserved_toktype t, nameKey_Name n, int i, mcComment_commentDesc comment, unsigned int l, unsigned int c, mcLexBuf_sourceList f); - -/* - isLastTokenEof - returns TRUE if the last token was an eoftok -*/ - -static unsigned int isLastTokenEof (void); - - -/* - debugLex - display the last, n, tokens. -*/ - -static void debugLex (unsigned int n) -{ - unsigned int c; - unsigned int i; - unsigned int o; - unsigned int t; - mcLexBuf_tokenBucket b; - - if (nextTokNo > n) - { - o = nextTokNo-n; - } - else - { - o = 0; - } - i = 0; - do { - t = o+i; - if (nextTokNo == t) - { - mcPrintf_printf0 ((const char *) "nextTokNo ", 10); - } - b = findtokenBucket (&t); - if (b == NULL) - { - t = o+i; - mcPrintf_printf1 ((const char *) "end of buf (%d is further ahead than the buffer contents)\\n", 60, (const unsigned char *) &t, (sizeof (t)-1)); - } - else - { - c = o+i; - mcPrintf_printf2 ((const char *) "entry %d %d ", 13, (const unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) &t, (sizeof (t)-1)); - displayToken (b->buf.array[t].token); - mcPrintf_printf0 ((const char *) "\\n", 2); - i += 1; - } - } while (! (b == NULL)); -} - - -/* - seekTo - -*/ - -static void seekTo (unsigned int t) -{ - mcLexBuf_tokenBucket b; - - nextTokNo = t; - if (t > 0) - { - t -= 1; - b = findtokenBucket (&t); - if (b == NULL) - { - updateFromBucket (b, t); - } - } -} - - -/* - peeptokenBucket - -*/ - -static mcLexBuf_tokenBucket peeptokenBucket (unsigned int *t) -{ - mcReserved_toktype ct; - unsigned int old; - unsigned int n; - mcLexBuf_tokenBucket b; - mcLexBuf_tokenBucket c; - - ct = mcLexBuf_currenttoken; - if (Debugging) - { - debugLex (5); - } - old = mcLexBuf_getTokenNo (); - do { - n = (*t); - b = findtokenBucket (&n); - if (b == NULL) - { - doGetToken (); - n = (*t); - b = findtokenBucket (&n); - if ((b == NULL) || (mcLexBuf_currenttoken == mcReserved_eoftok)) - { - /* bailing out. */ - nextTokNo = old+1; - b = findtokenBucket (&old); - updateFromBucket (b, old); - return NULL; - } - } - } while (! ((b != NULL) || (mcLexBuf_currenttoken == mcReserved_eoftok))); - (*t) = n; - nextTokNo = old+1; - if (Debugging) - { - mcPrintf_printf2 ((const char *) "nextTokNo = %d, old = %d\\n", 26, (const unsigned char *) &nextTokNo, (sizeof (nextTokNo)-1), (const unsigned char *) &old, (sizeof (old)-1)); - } - b = findtokenBucket (&old); - if (Debugging) - { - mcPrintf_printf1 ((const char *) " adjusted old = %d\\n", 21, (const unsigned char *) &old, (sizeof (old)-1)); - } - if (b != NULL) - { - updateFromBucket (b, old); - } - if (Debugging) - { - debugLex (5); - } - mcDebug_assert (ct == mcLexBuf_currenttoken); - return b; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - peepAfterComment - peeps ahead looking for an after statement comment. It stops at an END token - or if the line number changes. -*/ - -static void peepAfterComment (void) -{ - unsigned int oldTokNo; - unsigned int t; - unsigned int peep; - unsigned int cno; - unsigned int nextline; - unsigned int curline; - mcLexBuf_tokenBucket b; - unsigned int finished; - - oldTokNo = nextTokNo; - cno = mcLexBuf_getTokenNo (); - curline = mcLexBuf_tokenToLineNo (cno, 0); - nextline = curline; - peep = 0; - finished = FALSE; - do { - t = cno+peep; - b = peeptokenBucket (&t); - if ((b == NULL) || (mcLexBuf_currenttoken == mcReserved_eoftok)) - { - finished = TRUE; - } - else - { - nextline = b->buf.array[t].line; - if (nextline == curline) - { - switch (b->buf.array[t].token) - { - case mcReserved_eoftok: - case mcReserved_endtok: - finished = TRUE; - break; - - case mcReserved_commenttok: - if (mcComment_isAfterComment (b->buf.array[t].com)) - { - afterComment = b->buf.array[t].com; - } - break; - - - default: - break; - } - } - else - { - finished = TRUE; - } - } - peep += 1; - } while (! (finished)); - seekTo (oldTokNo); -} - - -/* - init - initializes the token list and source list. -*/ - -static void init (void) -{ - mcLexBuf_currenttoken = mcReserved_eoftok; - nextTokNo = 0; - currentSource = NULL; - listOfTokens.head = NULL; - listOfTokens.tail = NULL; - useBufferedTokens = FALSE; - procedureComment = static_cast (NULL); - bodyComment = static_cast (NULL); - afterComment = static_cast (NULL); - mcLexBuf_lastcomment = static_cast (NULL); -} - - -/* - addTo - adds a new element to the end of sourceList, currentSource. -*/ - -static void addTo (mcLexBuf_sourceList l) -{ - l->right = currentSource; - l->left = currentSource->left; - currentSource->left->right = l; - currentSource->left = l; - l->left->line = mcflex_getLineNo (); - l->left->col = mcflex_getColumnNo (); -} - - -/* - subFrom - subtracts, l, from the source list. -*/ - -static void subFrom (mcLexBuf_sourceList l) -{ - l->left->right = l->right; - l->right->left = l->left; -} - - -/* - newElement - returns a new sourceList -*/ - -static mcLexBuf_sourceList newElement (void * s) -{ - mcLexBuf_sourceList l; - - Storage_ALLOCATE ((void **) &l, sizeof (mcLexBuf__T1)); - if (l == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - l->name = DynamicStrings_InitStringCharStar (s); - l->left = NULL; - l->right = NULL; - } - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - newList - initializes an empty list with the classic dummy header element. -*/ - -static mcLexBuf_sourceList newList (void) -{ - mcLexBuf_sourceList l; - - Storage_ALLOCATE ((void **) &l, sizeof (mcLexBuf__T1)); - l->left = l; - l->right = l; - l->name = static_cast (NULL); - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkIfNeedToDuplicate - checks to see whether the currentSource has - been used, if it has then duplicate the list. -*/ - -static void checkIfNeedToDuplicate (void) -{ - mcLexBuf_sourceList l; - mcLexBuf_sourceList h; - - if (currentUsed) - { - l = currentSource->right; - h = currentSource; - currentSource = newList (); - while (l != h) - { - addTo (newElement (reinterpret_cast (l->name))); - l = l->right; - } - } -} - - -/* - killList - kills the sourceList providing that it has not been used. -*/ - -static void killList (void) -{ - mcLexBuf_sourceList l; - mcLexBuf_sourceList k; - - if (! currentUsed && (currentSource != NULL)) - { - l = currentSource; - do { - k = l; - l = l->right; - Storage_DEALLOCATE ((void **) &k, sizeof (mcLexBuf__T1)); - } while (! (l == currentSource)); - } -} - - -/* - displayToken - -*/ - -static void displayToken (mcReserved_toktype t) -{ - switch (t) - { - case mcReserved_eoftok: - mcPrintf_printf0 ((const char *) "eoftok\\n", 8); - break; - - case mcReserved_plustok: - mcPrintf_printf0 ((const char *) "plustok\\n", 9); - break; - - case mcReserved_minustok: - mcPrintf_printf0 ((const char *) "minustok\\n", 10); - break; - - case mcReserved_timestok: - mcPrintf_printf0 ((const char *) "timestok\\n", 10); - break; - - case mcReserved_dividetok: - mcPrintf_printf0 ((const char *) "dividetok\\n", 11); - break; - - case mcReserved_becomestok: - mcPrintf_printf0 ((const char *) "becomestok\\n", 12); - break; - - case mcReserved_ambersandtok: - mcPrintf_printf0 ((const char *) "ambersandtok\\n", 14); - break; - - case mcReserved_periodtok: - mcPrintf_printf0 ((const char *) "periodtok\\n", 11); - break; - - case mcReserved_commatok: - mcPrintf_printf0 ((const char *) "commatok\\n", 10); - break; - - case mcReserved_commenttok: - mcPrintf_printf0 ((const char *) "commenttok\\n", 12); - break; - - case mcReserved_semicolontok: - mcPrintf_printf0 ((const char *) "semicolontok\\n", 14); - break; - - case mcReserved_lparatok: - mcPrintf_printf0 ((const char *) "lparatok\\n", 10); - break; - - case mcReserved_rparatok: - mcPrintf_printf0 ((const char *) "rparatok\\n", 10); - break; - - case mcReserved_lsbratok: - mcPrintf_printf0 ((const char *) "lsbratok\\n", 10); - break; - - case mcReserved_rsbratok: - mcPrintf_printf0 ((const char *) "rsbratok\\n", 10); - break; - - case mcReserved_lcbratok: - mcPrintf_printf0 ((const char *) "lcbratok\\n", 10); - break; - - case mcReserved_rcbratok: - mcPrintf_printf0 ((const char *) "rcbratok\\n", 10); - break; - - case mcReserved_uparrowtok: - mcPrintf_printf0 ((const char *) "uparrowtok\\n", 12); - break; - - case mcReserved_singlequotetok: - mcPrintf_printf0 ((const char *) "singlequotetok\\n", 16); - break; - - case mcReserved_equaltok: - mcPrintf_printf0 ((const char *) "equaltok\\n", 10); - break; - - case mcReserved_hashtok: - mcPrintf_printf0 ((const char *) "hashtok\\n", 9); - break; - - case mcReserved_lesstok: - mcPrintf_printf0 ((const char *) "lesstok\\n", 9); - break; - - case mcReserved_greatertok: - mcPrintf_printf0 ((const char *) "greatertok\\n", 12); - break; - - case mcReserved_lessgreatertok: - mcPrintf_printf0 ((const char *) "lessgreatertok\\n", 16); - break; - - case mcReserved_lessequaltok: - mcPrintf_printf0 ((const char *) "lessequaltok\\n", 14); - break; - - case mcReserved_greaterequaltok: - mcPrintf_printf0 ((const char *) "greaterequaltok\\n", 17); - break; - - case mcReserved_periodperiodtok: - mcPrintf_printf0 ((const char *) "periodperiodtok\\n", 17); - break; - - case mcReserved_colontok: - mcPrintf_printf0 ((const char *) "colontok\\n", 10); - break; - - case mcReserved_doublequotestok: - mcPrintf_printf0 ((const char *) "doublequotestok\\n", 17); - break; - - case mcReserved_bartok: - mcPrintf_printf0 ((const char *) "bartok\\n", 8); - break; - - case mcReserved_andtok: - mcPrintf_printf0 ((const char *) "andtok\\n", 8); - break; - - case mcReserved_arraytok: - mcPrintf_printf0 ((const char *) "arraytok\\n", 10); - break; - - case mcReserved_begintok: - mcPrintf_printf0 ((const char *) "begintok\\n", 10); - break; - - case mcReserved_bytok: - mcPrintf_printf0 ((const char *) "bytok\\n", 7); - break; - - case mcReserved_casetok: - mcPrintf_printf0 ((const char *) "casetok\\n", 9); - break; - - case mcReserved_consttok: - mcPrintf_printf0 ((const char *) "consttok\\n", 10); - break; - - case mcReserved_definitiontok: - mcPrintf_printf0 ((const char *) "definitiontok\\n", 15); - break; - - case mcReserved_divtok: - mcPrintf_printf0 ((const char *) "divtok\\n", 8); - break; - - case mcReserved_dotok: - mcPrintf_printf0 ((const char *) "dotok\\n", 7); - break; - - case mcReserved_elsetok: - mcPrintf_printf0 ((const char *) "elsetok\\n", 9); - break; - - case mcReserved_elsiftok: - mcPrintf_printf0 ((const char *) "elsiftok\\n", 10); - break; - - case mcReserved_endtok: - mcPrintf_printf0 ((const char *) "endtok\\n", 8); - break; - - case mcReserved_exittok: - mcPrintf_printf0 ((const char *) "exittok\\n", 9); - break; - - case mcReserved_exporttok: - mcPrintf_printf0 ((const char *) "exporttok\\n", 11); - break; - - case mcReserved_fortok: - mcPrintf_printf0 ((const char *) "fortok\\n", 8); - break; - - case mcReserved_fromtok: - mcPrintf_printf0 ((const char *) "fromtok\\n", 9); - break; - - case mcReserved_iftok: - mcPrintf_printf0 ((const char *) "iftok\\n", 7); - break; - - case mcReserved_implementationtok: - mcPrintf_printf0 ((const char *) "implementationtok\\n", 19); - break; - - case mcReserved_importtok: - mcPrintf_printf0 ((const char *) "importtok\\n", 11); - break; - - case mcReserved_intok: - mcPrintf_printf0 ((const char *) "intok\\n", 7); - break; - - case mcReserved_looptok: - mcPrintf_printf0 ((const char *) "looptok\\n", 9); - break; - - case mcReserved_modtok: - mcPrintf_printf0 ((const char *) "modtok\\n", 8); - break; - - case mcReserved_moduletok: - mcPrintf_printf0 ((const char *) "moduletok\\n", 11); - break; - - case mcReserved_nottok: - mcPrintf_printf0 ((const char *) "nottok\\n", 8); - break; - - case mcReserved_oftok: - mcPrintf_printf0 ((const char *) "oftok\\n", 7); - break; - - case mcReserved_ortok: - mcPrintf_printf0 ((const char *) "ortok\\n", 7); - break; - - case mcReserved_pointertok: - mcPrintf_printf0 ((const char *) "pointertok\\n", 12); - break; - - case mcReserved_proceduretok: - mcPrintf_printf0 ((const char *) "proceduretok\\n", 14); - break; - - case mcReserved_qualifiedtok: - mcPrintf_printf0 ((const char *) "qualifiedtok\\n", 14); - break; - - case mcReserved_unqualifiedtok: - mcPrintf_printf0 ((const char *) "unqualifiedtok\\n", 16); - break; - - case mcReserved_recordtok: - mcPrintf_printf0 ((const char *) "recordtok\\n", 11); - break; - - case mcReserved_repeattok: - mcPrintf_printf0 ((const char *) "repeattok\\n", 11); - break; - - case mcReserved_returntok: - mcPrintf_printf0 ((const char *) "returntok\\n", 11); - break; - - case mcReserved_settok: - mcPrintf_printf0 ((const char *) "settok\\n", 8); - break; - - case mcReserved_thentok: - mcPrintf_printf0 ((const char *) "thentok\\n", 9); - break; - - case mcReserved_totok: - mcPrintf_printf0 ((const char *) "totok\\n", 7); - break; - - case mcReserved_typetok: - mcPrintf_printf0 ((const char *) "typetok\\n", 9); - break; - - case mcReserved_untiltok: - mcPrintf_printf0 ((const char *) "untiltok\\n", 10); - break; - - case mcReserved_vartok: - mcPrintf_printf0 ((const char *) "vartok\\n", 8); - break; - - case mcReserved_whiletok: - mcPrintf_printf0 ((const char *) "whiletok\\n", 10); - break; - - case mcReserved_withtok: - mcPrintf_printf0 ((const char *) "withtok\\n", 9); - break; - - case mcReserved_asmtok: - mcPrintf_printf0 ((const char *) "asmtok\\n", 8); - break; - - case mcReserved_volatiletok: - mcPrintf_printf0 ((const char *) "volatiletok\\n", 13); - break; - - case mcReserved_periodperiodperiodtok: - mcPrintf_printf0 ((const char *) "periodperiodperiodtok\\n", 23); - break; - - case mcReserved_datetok: - mcPrintf_printf0 ((const char *) "datetok\\n", 9); - break; - - case mcReserved_linetok: - mcPrintf_printf0 ((const char *) "linetok\\n", 9); - break; - - case mcReserved_filetok: - mcPrintf_printf0 ((const char *) "filetok\\n", 9); - break; - - case mcReserved_integertok: - mcPrintf_printf0 ((const char *) "integertok\\n", 12); - break; - - case mcReserved_identtok: - mcPrintf_printf0 ((const char *) "identtok\\n", 10); - break; - - case mcReserved_realtok: - mcPrintf_printf0 ((const char *) "realtok\\n", 9); - break; - - case mcReserved_stringtok: - mcPrintf_printf0 ((const char *) "stringtok\\n", 11); - break; - - - default: - mcPrintf_printf0 ((const char *) "unknown tok (--fixme--)\\n", 25); - break; - } -} - - -/* - updateFromBucket - updates the global variables: currenttoken, - currentstring, currentcolumn and currentinteger - from tokenBucket, b, and, offset. -*/ - -static void updateFromBucket (mcLexBuf_tokenBucket b, unsigned int offset) -{ - mcLexBuf_currenttoken = b->buf.array[offset].token; - mcLexBuf_currentstring = nameKey_keyToCharStar (b->buf.array[offset].str); - mcLexBuf_currentcolumn = b->buf.array[offset].col; - mcLexBuf_currentinteger = b->buf.array[offset].int_; - mcLexBuf_currentcomment = b->buf.array[offset].com; - if (mcLexBuf_currentcomment != NULL) - { - mcLexBuf_lastcomment = mcLexBuf_currentcomment; - } - if (Debugging) - { - mcPrintf_printf3 ((const char *) "line %d (# %d %d) ", 19, (const unsigned char *) &b->buf.array[offset].line, (sizeof (b->buf.array[offset].line)-1), (const unsigned char *) &offset, (sizeof (offset)-1), (const unsigned char *) &nextTokNo, (sizeof (nextTokNo)-1)); - } -} - - -/* - doGetToken - fetch the next token into currenttoken. -*/ - -static void doGetToken (void) -{ - void * a; - unsigned int t; - mcLexBuf_tokenBucket b; - - if (useBufferedTokens) - { - t = nextTokNo; - b = findtokenBucket (&t); - updateFromBucket (b, t); - } - else - { - if (listOfTokens.tail == NULL) - { - a = mcflex_getToken (); - if (listOfTokens.tail == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - if (nextTokNo >= listOfTokens.lastBucketOffset) - { - /* nextTokNo is in the last bucket or needs to be read. */ - if ((nextTokNo-listOfTokens.lastBucketOffset) < listOfTokens.tail->len) - { - if (Debugging) - { - mcPrintf_printf0 ((const char *) "fetching token from buffer (updateFromBucket)\\n", 47); - } - updateFromBucket (listOfTokens.tail, nextTokNo-listOfTokens.lastBucketOffset); - } - else - { - if (Debugging) - { - mcPrintf_printf0 ((const char *) "calling flex to place token into buffer\\n", 41); - } - /* call the lexical phase to place a new token into the last bucket. */ - a = mcflex_getToken (); - mcLexBuf_getToken (); /* and call ourselves again to collect the token from bucket. */ - return ; /* and call ourselves again to collect the token from bucket. */ - } - } - else - { - if (Debugging) - { - mcPrintf_printf0 ((const char *) "fetching token from buffer\\n", 28); - } - t = nextTokNo; - b = findtokenBucket (&t); - updateFromBucket (b, t); - } - } - if (Debugging) - { - displayToken (mcLexBuf_currenttoken); - } - nextTokNo += 1; -} - - -/* - syncOpenWithBuffer - synchronise the buffer with the start of a file. - Skips all the tokens to do with the previous file. -*/ - -static void syncOpenWithBuffer (void) -{ - if (listOfTokens.tail != NULL) - { - nextTokNo = listOfTokens.lastBucketOffset+listOfTokens.tail->len; - } -} - - -/* - findtokenBucket - returns the tokenBucket corresponding to the tokenNo. -*/ - -static mcLexBuf_tokenBucket findtokenBucket (unsigned int *tokenNo) -{ - mcLexBuf_tokenBucket b; - - b = listOfTokens.head; - while (b != NULL) - { - if ((*tokenNo) < b->len) - { - return b; - } - else - { - (*tokenNo) -= b->len; - } - b = b->next; - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getFileName - returns a String defining the current file. -*/ - -static void stop (void) -{ -} - - -/* - addTokToList - adds a token to a dynamic list. -*/ - -static void addTokToList (mcReserved_toktype t, nameKey_Name n, int i, mcComment_commentDesc comment, unsigned int l, unsigned int c, mcLexBuf_sourceList f) -{ - mcLexBuf_tokenBucket b; - - if (listOfTokens.head == NULL) - { - Storage_ALLOCATE ((void **) &listOfTokens.head, sizeof (mcLexBuf__T2)); - if (listOfTokens.head == NULL) - {} /* empty. */ - /* list error */ - listOfTokens.tail = listOfTokens.head; - listOfTokens.tail->len = 0; - } - else if (listOfTokens.tail->len == MaxBucketSize) - { - /* avoid dangling else. */ - mcDebug_assert (listOfTokens.tail->next == NULL); - Storage_ALLOCATE ((void **) &listOfTokens.tail->next, sizeof (mcLexBuf__T2)); - if (listOfTokens.tail->next == NULL) - {} /* empty. */ - else - { - /* list error */ - listOfTokens.tail = listOfTokens.tail->next; - listOfTokens.tail->len = 0; - } - listOfTokens.lastBucketOffset += MaxBucketSize; - } - listOfTokens.tail->next = NULL; - mcDebug_assert (listOfTokens.tail->len != MaxBucketSize); - listOfTokens.tail->buf.array[listOfTokens.tail->len].token = t; - listOfTokens.tail->buf.array[listOfTokens.tail->len].str = n; - listOfTokens.tail->buf.array[listOfTokens.tail->len].int_ = i; - listOfTokens.tail->buf.array[listOfTokens.tail->len].com = comment; - listOfTokens.tail->buf.array[listOfTokens.tail->len].line = l; - listOfTokens.tail->buf.array[listOfTokens.tail->len].col = c; - listOfTokens.tail->buf.array[listOfTokens.tail->len].file = f; - listOfTokens.tail->len += 1; -} - - -/* - isLastTokenEof - returns TRUE if the last token was an eoftok -*/ - -static unsigned int isLastTokenEof (void) -{ - unsigned int t; - mcLexBuf_tokenBucket b; - - if (listOfTokens.tail != NULL) - { - if (listOfTokens.tail->len == 0) - { - b = listOfTokens.head; - if (b == listOfTokens.tail) - { - return FALSE; - } - while (b->next != listOfTokens.tail) - { - b = b->next; - } - } - else - { - b = listOfTokens.tail; - } - mcDebug_assert (b->len > 0); /* len should always be >0 */ - return b->buf.array[b->len-1].token == mcReserved_eoftok; /* len should always be >0 */ - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getProcedureComment - returns the procedure comment if it exists, - or NIL otherwise. -*/ - -extern "C" mcComment_commentDesc mcLexBuf_getProcedureComment (void) -{ - return procedureComment; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getBodyComment - returns the body comment if it exists, - or NIL otherwise. The body comment is - removed if found. -*/ - -extern "C" mcComment_commentDesc mcLexBuf_getBodyComment (void) -{ - mcComment_commentDesc b; - - b = bodyComment; - bodyComment = static_cast (NULL); - return b; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getAfterComment - returns the after comment if it exists, - or NIL otherwise. The after comment is - removed if found. -*/ - -extern "C" mcComment_commentDesc mcLexBuf_getAfterComment (void) -{ - mcComment_commentDesc a; - - peepAfterComment (); - a = afterComment; - afterComment = static_cast (NULL); - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openSource - attempts to open the source file, s. - The success of the operation is returned. -*/ - -extern "C" unsigned int mcLexBuf_openSource (DynamicStrings_String s) -{ - if (useBufferedTokens) - { - mcLexBuf_getToken (); - return TRUE; - } - else - { - if (mcflex_openSource (DynamicStrings_string (s))) - { - mcLexBuf_setFile (DynamicStrings_string (s)); - syncOpenWithBuffer (); - mcLexBuf_getToken (); - return TRUE; - } - else - { - return FALSE; - } - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - closeSource - closes the current open file. -*/ - -extern "C" void mcLexBuf_closeSource (void) -{ - if (useBufferedTokens) - { - while (mcLexBuf_currenttoken != mcReserved_eoftok) - { - mcLexBuf_getToken (); - } - } - /* a subsequent call to mcflex.OpenSource will really close the file */ -} - - -/* - reInitialize - re-initialize the all the data structures. -*/ - -extern "C" void mcLexBuf_reInitialize (void) -{ - mcLexBuf_tokenBucket s; - mcLexBuf_tokenBucket t; - - if (listOfTokens.head != NULL) - { - t = listOfTokens.head; - do { - s = t; - t = t->next; - Storage_DEALLOCATE ((void **) &s, sizeof (mcLexBuf__T2)); - } while (! (t == NULL)); - currentUsed = FALSE; - killList (); - } - init (); -} - - -/* - resetForNewPass - reset the buffer pointers to the beginning ready for - a new pass -*/ - -extern "C" void mcLexBuf_resetForNewPass (void) -{ - nextTokNo = 0; - useBufferedTokens = TRUE; -} - - -/* - getToken - gets the next token into currenttoken. -*/ - -extern "C" void mcLexBuf_getToken (void) -{ - do { - doGetToken (); - if (mcLexBuf_currenttoken == mcReserved_commenttok) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (mcComment_isProcedureComment (mcLexBuf_currentcomment)) - { - procedureComment = mcLexBuf_currentcomment; - bodyComment = static_cast (NULL); - afterComment = static_cast (NULL); - } - else if (mcComment_isBodyComment (mcLexBuf_currentcomment)) - { - /* avoid dangling else. */ - bodyComment = mcLexBuf_currentcomment; - afterComment = static_cast (NULL); - } - else if (mcComment_isAfterComment (mcLexBuf_currentcomment)) - { - /* avoid dangling else. */ - procedureComment = static_cast (NULL); - bodyComment = static_cast (NULL); - afterComment = mcLexBuf_currentcomment; - } - } - } while (! (mcLexBuf_currenttoken != mcReserved_commenttok)); -} - - -/* - insertToken - inserts a symbol, token, infront of the current token - ready for the next pass. -*/ - -extern "C" void mcLexBuf_insertToken (mcReserved_toktype token) -{ - if (listOfTokens.tail != NULL) - { - if (listOfTokens.tail->len > 0) - { - listOfTokens.tail->buf.array[listOfTokens.tail->len-1].token = token; - } - addTokToList (mcLexBuf_currenttoken, nameKey_NulName, 0, static_cast (NULL), mcLexBuf_getLineNo (), mcLexBuf_getColumnNo (), currentSource); - mcLexBuf_getToken (); - } -} - - -/* - insertTokenAndRewind - inserts a symbol, token, infront of the current token - and then moves the token stream back onto the inserted token. -*/ - -extern "C" void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token) -{ - if (listOfTokens.tail != NULL) - { - if (listOfTokens.tail->len > 0) - { - listOfTokens.tail->buf.array[listOfTokens.tail->len-1].token = token; - } - addTokToList (mcLexBuf_currenttoken, nameKey_NulName, 0, static_cast (NULL), mcLexBuf_getLineNo (), mcLexBuf_getColumnNo (), currentSource); - mcLexBuf_currenttoken = token; - } -} - - -/* - getPreviousTokenLineNo - returns the line number of the previous token. -*/ - -extern "C" unsigned int mcLexBuf_getPreviousTokenLineNo (void) -{ - return mcLexBuf_getLineNo (); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getLineNo - returns the current line number where the symbol occurs in - the source file. -*/ - -extern "C" unsigned int mcLexBuf_getLineNo (void) -{ - if (nextTokNo == 0) - { - return 0; - } - else - { - return mcLexBuf_tokenToLineNo (mcLexBuf_getTokenNo (), 0); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getTokenNo - returns the current token number. -*/ - -extern "C" unsigned int mcLexBuf_getTokenNo (void) -{ - if (nextTokNo == 0) - { - return 0; - } - else - { - return nextTokNo-1; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - tokenToLineNo - returns the line number of the current file for the - tokenNo. The depth refers to the include depth. - A depth of 0 is the current file, depth of 1 is the file - which included the current file. Zero is returned if the - depth exceeds the file nesting level. -*/ - -extern "C" unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth) -{ - mcLexBuf_tokenBucket b; - mcLexBuf_sourceList l; - - b = findtokenBucket (&tokenNo); - if (b == NULL) - { - return 0; - } - else - { - if (depth == 0) - { - return b->buf.array[tokenNo].line; - } - else - { - l = b->buf.array[tokenNo].file->left; - while (depth > 0) - { - l = l->left; - if (l == b->buf.array[tokenNo].file->left) - { - return 0; - } - depth -= 1; - } - return l->line; - } - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getColumnNo - returns the current column where the symbol occurs in - the source file. -*/ - -extern "C" unsigned int mcLexBuf_getColumnNo (void) -{ - if (nextTokNo == 0) - { - return 0; - } - else - { - return mcLexBuf_tokenToColumnNo (mcLexBuf_getTokenNo (), 0); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - tokenToColumnNo - returns the column number of the current file for the - tokenNo. The depth refers to the include depth. - A depth of 0 is the current file, depth of 1 is the file - which included the current file. Zero is returned if the - depth exceeds the file nesting level. -*/ - -extern "C" unsigned int mcLexBuf_tokenToColumnNo (unsigned int tokenNo, unsigned int depth) -{ - mcLexBuf_tokenBucket b; - mcLexBuf_sourceList l; - - b = findtokenBucket (&tokenNo); - if (b == NULL) - { - return 0; - } - else - { - if (depth == 0) - { - return b->buf.array[tokenNo].col; - } - else - { - l = b->buf.array[tokenNo].file->left; - while (depth > 0) - { - l = l->left; - if (l == b->buf.array[tokenNo].file->left) - { - return 0; - } - depth -= 1; - } - return l->col; - } - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - findFileNameFromToken - returns the complete FileName for the appropriate - source file yields the token number, tokenNo. - The, Depth, indicates the include level: 0..n - Level 0 is the current. NIL is returned if n+1 - is requested. -*/ - -extern "C" DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth) -{ - mcLexBuf_tokenBucket b; - mcLexBuf_sourceList l; - - b = findtokenBucket (&tokenNo); - if (b == NULL) - { - return static_cast (NULL); - } - else - { - l = b->buf.array[tokenNo].file->left; - while (depth > 0) - { - l = l->left; - if (l == b->buf.array[tokenNo].file->left) - { - return static_cast (NULL); - } - depth -= 1; - } - return l->name; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getFileName - returns a String defining the current file. -*/ - -extern "C" DynamicStrings_String mcLexBuf_getFileName (void) -{ - return mcLexBuf_findFileNameFromToken (mcLexBuf_getTokenNo (), 0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addTok - adds a token to the buffer. -*/ - -extern "C" void mcLexBuf_addTok (mcReserved_toktype t) -{ - if (! ((t == mcReserved_eoftok) && (isLastTokenEof ()))) - { - addTokToList (t, nameKey_NulName, 0, static_cast (NULL), mcflex_getLineNo (), mcflex_getColumnNo (), currentSource); - currentUsed = TRUE; - } -} - - -/* - addTokCharStar - adds a token to the buffer and an additional string, s. - A copy of string, s, is made. -*/ - -extern "C" void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s) -{ - if ((libc_strlen (s)) > 80) - { - stop (); - } - addTokToList (t, nameKey_makekey (s), 0, static_cast (NULL), mcflex_getLineNo (), mcflex_getColumnNo (), currentSource); - currentUsed = TRUE; -} - - -/* - addTokInteger - adds a token and an integer to the buffer. -*/ - -extern "C" void mcLexBuf_addTokInteger (mcReserved_toktype t, int i) -{ - DynamicStrings_String s; - unsigned int c; - unsigned int l; - - l = mcflex_getLineNo (); - c = mcflex_getColumnNo (); - s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%d", 2)), (const unsigned char *) &i, (sizeof (i)-1)); - addTokToList (t, nameKey_makekey (DynamicStrings_string (s)), i, static_cast (NULL), l, c, currentSource); - s = DynamicStrings_KillString (s); - currentUsed = TRUE; -} - - -/* - addTokComment - adds a token to the buffer and a comment descriptor, com. -*/ - -extern "C" void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com) -{ - addTokToList (t, nameKey_NulName, 0, com, mcflex_getLineNo (), mcflex_getColumnNo (), currentSource); - currentUsed = TRUE; -} - - -/* - setFile - sets the current filename to, filename. -*/ - -extern "C" void mcLexBuf_setFile (void * filename) -{ - killList (); - currentUsed = FALSE; - currentSource = newList (); - addTo (newElement (filename)); -} - - -/* - pushFile - indicates that, filename, has just been included. -*/ - -extern "C" void mcLexBuf_pushFile (void * filename) -{ - mcLexBuf_sourceList l; - - checkIfNeedToDuplicate (); - addTo (newElement (filename)); - if (Debugging) - { - if (currentSource->right != currentSource) - { - l = currentSource; - do { - mcPrintf_printf3 ((const char *) "name = %s, line = %d, col = %d\\n", 32, (const unsigned char *) &l->name, (sizeof (l->name)-1), (const unsigned char *) &l->line, (sizeof (l->line)-1), (const unsigned char *) &l->col, (sizeof (l->col)-1)); - l = l->right; - } while (! (l == currentSource)); - } - } -} - - -/* - popFile - indicates that we are returning to, filename, having finished - an include. -*/ - -extern "C" void mcLexBuf_popFile (void * filename) -{ - mcLexBuf_sourceList l; - - checkIfNeedToDuplicate (); - if ((currentSource != NULL) && (currentSource->left != currentSource)) - { - /* avoid dangling else. */ - l = currentSource->left; /* last element */ - subFrom (l); /* last element */ - Storage_DEALLOCATE ((void **) &l, sizeof (mcLexBuf__T1)); - if ((currentSource->left != currentSource) && (! (DynamicStrings_Equal (currentSource->name, DynamicStrings_Mark (DynamicStrings_InitStringCharStar (filename)))))) - {} /* empty. */ - /* mismatch in source file names after preprocessing files */ - } - /* source file list is empty, cannot pop an include.. */ -} - -extern "C" void _M2_mcLexBuf_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - init (); -} - -extern "C" void _M2_mcLexBuf_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcMetaError.c b/gcc/m2/mc-boot/GmcMetaError.c deleted file mode 100644 index 4d406851d0be..000000000000 --- a/gcc/m2/mc-boot/GmcMetaError.c +++ /dev/null @@ -1,1880 +0,0 @@ -/* do not edit automatically generated by mc from mcMetaError. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcMetaError_H -#define _mcMetaError_C - -# include "GnameKey.h" -# include "GStrLib.h" -# include "GmcLexBuf.h" -# include "GmcError.h" -# include "GFIO.h" -# include "GSFIO.h" -# include "GStringConvert.h" -# include "Gvarargs.h" -# include "GDynamicStrings.h" -# include "Gdecl.h" - -typedef enum {mcMetaError_newerror, mcMetaError_newwarning, mcMetaError_chained} mcMetaError_errorType; - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaError2 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaError3 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaError4 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrors1 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrors2 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrors3 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrors4 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorT2 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorT3 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorT4 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorsT1 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorsT2 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorsT3 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorsT4 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorString3 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorString4 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorStringT2 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorStringT3 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high); - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorStringT4 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high); - -/* - internalFormat - produces an informative internal error. -*/ - -static void internalFormat (DynamicStrings_String s, int i, const char *m_, unsigned int _m_high); - -/* - x - checks to see that a=b. -*/ - -static DynamicStrings_String x (DynamicStrings_String a, DynamicStrings_String b); - -/* - isWhite - returns TRUE if, ch, is a space. -*/ - -static unsigned int isWhite (char ch); - -/* - then := [ ':' ebnf ] =: -*/ - -static void then (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, DynamicStrings_String o, unsigned int positive); - -/* - doNumber - -*/ - -static DynamicStrings_String doNumber (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes); - -/* - doCount - -*/ - -static DynamicStrings_String doCount (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes); - -/* - doCount - -*/ - -static DynamicStrings_String doAscii (unsigned int bol, varargs_vararg sym, DynamicStrings_String o); - -/* - doCount - -*/ - -static DynamicStrings_String doName (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes); - -/* - doCount - -*/ - -static DynamicStrings_String doQualified (unsigned int bol, varargs_vararg sym, DynamicStrings_String o); - -/* - doType - returns a string containing the type name of - sym. It will skip pseudonym types. It also - returns the type symbol found. -*/ - -static DynamicStrings_String doType (unsigned int bol, varargs_vararg *sym, DynamicStrings_String o); - -/* - doSkipType - will skip all pseudonym types. It also - returns the type symbol found and name. -*/ - -static DynamicStrings_String doSkipType (unsigned int bol, varargs_vararg *sym, DynamicStrings_String o); - -/* - doSkipType - will skip all pseudonym types. It also - returns the type symbol found and name. -*/ - -static DynamicStrings_String doKey (unsigned int bol, varargs_vararg sym, DynamicStrings_String o); - -/* - doError - creates and returns an error note. -*/ - -static mcError_error doError (mcError_error e, mcMetaError_errorType t, unsigned int tok); - -/* - doDeclaredDef - creates an error note where sym[bol] was declared. -*/ - -static mcError_error doDeclaredDef (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym); - -/* - doDeclaredMod - creates an error note where sym[bol] was declared. -*/ - -static mcError_error doDeclaredMod (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym); - -/* - doUsed - creates an error note where sym[bol] was first used. -*/ - -static mcError_error doUsed (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym); - -/* - ConCatWord - joins sentances, a, b, together. -*/ - -static DynamicStrings_String ConCatWord (DynamicStrings_String a, DynamicStrings_String b); - -/* - symDesc - -*/ - -static DynamicStrings_String symDesc (decl_node n, DynamicStrings_String o); - -/* - doDesc - -*/ - -static DynamicStrings_String doDesc (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes); - -/* - addQuoted - if, o, is not empty then add it to, r. -*/ - -static DynamicStrings_String addQuoted (DynamicStrings_String r, DynamicStrings_String o, unsigned int quotes); - -/* - op := {'a'|'q'|'t'|'d'|'k'|'n'|'s'|'D'|'I'|'U'|'E'|'W'} then =: -*/ - -static void op (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, unsigned int bol, unsigned int positive); - -/* - percenttoken := '%' ( - '1' % doOperand(1) % - op - | '2' % doOperand(2) % - op - | '3' % doOperand(3) % - op - | '4' % doOperand(4) % - op - ) - } =: -*/ - -static void percenttoken (mcError_error *e, mcMetaError_errorType t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, unsigned int positive); - -/* - percent := '%' anych % copy anych % - =: -*/ - -static void percent (DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l); - -/* - lbra := '{' [ '!' ] percenttoken '}' =: -*/ - -static void lbra (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l); - -/* - lbra := '{' [ '!' ] percenttoken '}' =: -*/ - -static void stop (void); - -/* - ebnf := { percent - | lbra - | any % copy ch % - } - =: -*/ - -static void ebnf (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l); - -/* - doFormat - -*/ - -static DynamicStrings_String doFormat (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String s, varargs_vararg sym); - -/* - wrapErrors - -*/ - -static void wrapErrors (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, varargs_vararg sym); - - -/* - internalFormat - produces an informative internal error. -*/ - -static void internalFormat (DynamicStrings_String s, int i, const char *m_, unsigned int _m_high) -{ - mcError_error e; - char m[_m_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - - e = mcError_newError (mcLexBuf_getTokenNo ()); - s = SFIO_WriteS (FIO_StdOut, s); - FIO_WriteLine (FIO_StdOut); - s = DynamicStrings_KillString (s); - if (i > 0) - { - i -= 1; - } - s = DynamicStrings_Mult (DynamicStrings_InitString ((const char *) " ", 1), static_cast (i)); - s = DynamicStrings_ConCatChar (s, '^'); - s = SFIO_WriteS (FIO_StdOut, s); - FIO_WriteLine (FIO_StdOut); - mcError_internalError ((const char *) m, _m_high, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 97); -} - - -/* - x - checks to see that a=b. -*/ - -static DynamicStrings_String x (DynamicStrings_String a, DynamicStrings_String b) -{ - if (a != b) - { - mcError_internalError ((const char *) "different string returned", 25, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 109); - } - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isWhite - returns TRUE if, ch, is a space. -*/ - -static unsigned int isWhite (char ch) -{ - return ch == ' '; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - then := [ ':' ebnf ] =: -*/ - -static void then (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, DynamicStrings_String o, unsigned int positive) -{ - if ((DynamicStrings_char (s, (*i))) == ':') - { - (*i) += 1; - ebnf (e, t, r, s, sym, i, l); - if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}')) - { - internalFormat (s, (*i), (const char *) "expecting to see }", 18); - } - } -} - - -/* - doNumber - -*/ - -static DynamicStrings_String doNumber (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes) -{ - unsigned int c; - - if ((DynamicStrings_Length (o)) > 0) - { - return o; - } - else - { - (*quotes) = FALSE; - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &c, (sizeof (c)-1)); - return DynamicStrings_ConCat (o, StringConvert_ctos (c, 0, ' ')); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doCount - -*/ - -static DynamicStrings_String doCount (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes) -{ - unsigned int c; - - if ((DynamicStrings_Length (o)) > 0) - { - return o; - } - else - { - (*quotes) = FALSE; - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &c, (sizeof (c)-1)); - o = DynamicStrings_ConCat (o, StringConvert_ctos (c, 0, ' ')); - if (((c % 100) >= 11) && ((c % 100) <= 13)) - { - o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "th", 2))); - } - - else { - switch (c % 10) - { - case 1: - o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "st", 2))); - break; - - case 2: - o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "nd", 2))); - break; - - case 3: - o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "rd", 2))); - break; - - - default: - o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "th", 2))); - break; - } - } - return o; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doCount - -*/ - -static DynamicStrings_String doAscii (unsigned int bol, varargs_vararg sym, DynamicStrings_String o) -{ - decl_node n; - - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1)); - if (((DynamicStrings_Length (o)) > 0) || (decl_isTemporary (n))) - { - return o; - } - else - { - return DynamicStrings_ConCat (o, DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)))); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doCount - -*/ - -static DynamicStrings_String doName (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes) -{ - decl_node n; - - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1)); - if (((DynamicStrings_Length (o)) > 0) || (decl_isTemporary (n))) - { - return o; - } - else - { - if (decl_isZtype (n)) - { - (*quotes) = FALSE; - return DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "the ZType", 9))); - } - else if (decl_isRtype (n)) - { - /* avoid dangling else. */ - (*quotes) = FALSE; - return DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "the RType", 9))); - } - else if ((decl_getSymName (n)) != nameKey_NulName) - { - /* avoid dangling else. */ - return DynamicStrings_ConCat (o, DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)))); - } - else - { - /* avoid dangling else. */ - return o; - } - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doCount - -*/ - -static DynamicStrings_String doQualified (unsigned int bol, varargs_vararg sym, DynamicStrings_String o) -{ - decl_node s; - decl_node n; - varargs_vararg mod; - - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1)); - if (((DynamicStrings_Length (o)) > 0) || (decl_isTemporary (n))) - { - return o; - } - else - { - s = decl_getScope (n); - mod = varargs_start1 ((const unsigned char *) &s, (sizeof (s)-1)); - if ((decl_isDef (s)) && (decl_isExported (n))) - { - o = x (o, doAscii (0, mod, o)); - o = x (o, DynamicStrings_ConCatChar (o, '.')); - o = x (o, DynamicStrings_ConCat (o, DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))))); - } - else - { - o = x (o, doAscii (bol, sym, o)); - } - varargs_end (&mod); - return o; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doType - returns a string containing the type name of - sym. It will skip pseudonym types. It also - returns the type symbol found. -*/ - -static DynamicStrings_String doType (unsigned int bol, varargs_vararg *sym, DynamicStrings_String o) -{ - decl_node n; - - varargs_next ((*sym), bol); - varargs_arg ((*sym), (unsigned char *) &n, (sizeof (n)-1)); - if (((DynamicStrings_Length (o)) > 0) || ((decl_getType (n)) == NULL)) - { - return o; - } - else - { - n = decl_skipType (decl_getType (n)); - varargs_next ((*sym), bol); - varargs_replace ((*sym), (unsigned char *) &n, (sizeof (n)-1)); - return x (o, doAscii (bol, (*sym), o)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doSkipType - will skip all pseudonym types. It also - returns the type symbol found and name. -*/ - -static DynamicStrings_String doSkipType (unsigned int bol, varargs_vararg *sym, DynamicStrings_String o) -{ - decl_node n; - - varargs_next ((*sym), bol); - varargs_arg ((*sym), (unsigned char *) &n, (sizeof (n)-1)); - if ((DynamicStrings_Length (o)) > 0) - { - return o; - } - else - { - n = decl_skipType (decl_getType (n)); - varargs_next ((*sym), bol); - varargs_replace ((*sym), (unsigned char *) &n, (sizeof (n)-1)); - if ((decl_getSymName (n)) == nameKey_NulName) - { - return o; - } - else - { - return x (o, doAscii (bol, (*sym), o)); - } - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doSkipType - will skip all pseudonym types. It also - returns the type symbol found and name. -*/ - -static DynamicStrings_String doKey (unsigned int bol, varargs_vararg sym, DynamicStrings_String o) -{ - nameKey_Name n; - - if ((DynamicStrings_Length (o)) > 0) - { - return o; - } - else - { - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1)); - return DynamicStrings_ConCat (o, DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doError - creates and returns an error note. -*/ - -static mcError_error doError (mcError_error e, mcMetaError_errorType t, unsigned int tok) -{ - switch (t) - { - case mcMetaError_chained: - if (e == NULL) - { - mcError_internalError ((const char *) "should not be chaining an error onto an empty error note", 56, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 355); - } - else - { - e = mcError_chainError (tok, e); - } - break; - - case mcMetaError_newerror: - if (e == NULL) - { - e = mcError_newError (tok); - } - break; - - case mcMetaError_newwarning: - if (e == NULL) - { - e = mcError_newWarning (tok); - } - break; - - - default: - mcError_internalError ((const char *) "unexpected enumeration value", 28, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 369); - break; - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doDeclaredDef - creates an error note where sym[bol] was declared. -*/ - -static mcError_error doDeclaredDef (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym) -{ - decl_node n; - - if (bol <= (varargs_nargs (sym))) - { - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1)); - e = doError (e, t, decl_getDeclaredDef (n)); - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doDeclaredMod - creates an error note where sym[bol] was declared. -*/ - -static mcError_error doDeclaredMod (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym) -{ - decl_node n; - - if (bol <= (varargs_nargs (sym))) - { - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1)); - e = doError (e, t, decl_getDeclaredMod (n)); - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doUsed - creates an error note where sym[bol] was first used. -*/ - -static mcError_error doUsed (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym) -{ - decl_node n; - - if (bol <= (varargs_nargs (sym))) - { - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1)); - e = doError (e, t, decl_getFirstUsed (n)); - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConCatWord - joins sentances, a, b, together. -*/ - -static DynamicStrings_String ConCatWord (DynamicStrings_String a, DynamicStrings_String b) -{ - if (((DynamicStrings_Length (a)) == 1) && ((DynamicStrings_char (a, 0)) == 'a')) - { - a = x (a, DynamicStrings_ConCatChar (a, 'n')); - } - else if ((((DynamicStrings_Length (a)) > 1) && ((DynamicStrings_char (a, -1)) == 'a')) && (isWhite (DynamicStrings_char (a, -2)))) - { - /* avoid dangling else. */ - a = x (a, DynamicStrings_ConCatChar (a, 'n')); - } - if (((DynamicStrings_Length (a)) > 0) && (! (isWhite (DynamicStrings_char (a, -1))))) - { - a = x (a, DynamicStrings_ConCatChar (a, ' ')); - } - return x (a, DynamicStrings_ConCat (a, b)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - symDesc - -*/ - -static DynamicStrings_String symDesc (decl_node n, DynamicStrings_String o) -{ - if (decl_isLiteral (n)) - { - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "literal", 7))); - } - else if (decl_isConstSet (n)) - { - /* avoid dangling else. */ - /* - ELSIF IsConstructor(n) - THEN - RETURN( ConCatWord (o, Mark (InitString ('constructor'))) ) - */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "constant set", 12))); - } - else if (decl_isConst (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "constant", 8))); - } - else if (decl_isArray (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "array", 5))); - } - else if (decl_isVar (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "variable", 8))); - } - else if (decl_isEnumeration (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "enumeration type", 16))); - } - else if (decl_isEnumerationField (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "enumeration field", 17))); - } - else if (decl_isUnbounded (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "unbounded parameter", 19))); - } - else if (decl_isProcType (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "procedure type", 14))); - } - else if (decl_isProcedure (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "procedure", 9))); - } - else if (decl_isPointer (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "pointer", 7))); - } - else if (decl_isParameter (n)) - { - /* avoid dangling else. */ - if (decl_isVarParam (n)) - { - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "var parameter", 13))); - } - else - { - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "parameter", 9))); - } - } - else if (decl_isType (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "type", 4))); - } - else if (decl_isRecord (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "record", 6))); - } - else if (decl_isRecordField (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "record field", 12))); - } - else if (decl_isVarient (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "varient record", 14))); - } - else if (decl_isModule (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "module", 6))); - } - else if (decl_isDef (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "definition module", 17))); - } - else if (decl_isImp (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "implementation module", 21))); - } - else if (decl_isSet (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "set", 3))); - } - else if (decl_isSubrange (n)) - { - /* avoid dangling else. */ - return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "subrange", 8))); - } - else - { - /* avoid dangling else. */ - return o; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doDesc - -*/ - -static DynamicStrings_String doDesc (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes) -{ - decl_node n; - - if ((DynamicStrings_Length (o)) == 0) - { - varargs_next (sym, bol); - varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1)); - o = symDesc (n, o); - if ((DynamicStrings_Length (o)) > 0) - { - (*quotes) = FALSE; - } - } - return o; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addQuoted - if, o, is not empty then add it to, r. -*/ - -static DynamicStrings_String addQuoted (DynamicStrings_String r, DynamicStrings_String o, unsigned int quotes) -{ - if ((DynamicStrings_Length (o)) > 0) - { - if (! (isWhite (DynamicStrings_char (r, -1)))) - { - r = x (r, DynamicStrings_ConCatChar (r, ' ')); - } - if (quotes) - { - r = x (r, DynamicStrings_ConCatChar (r, '\'')); - } - r = x (r, DynamicStrings_ConCat (r, o)); - if (quotes) - { - r = x (r, DynamicStrings_ConCatChar (r, '\'')); - } - } - return r; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - op := {'a'|'q'|'t'|'d'|'k'|'n'|'s'|'D'|'I'|'U'|'E'|'W'} then =: -*/ - -static void op (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, unsigned int bol, unsigned int positive) -{ - DynamicStrings_String o; - varargs_vararg c; - unsigned int quotes; - - c = varargs_copy (sym); - o = DynamicStrings_InitString ((const char *) "", 0); - quotes = TRUE; - while (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}')) - { - switch (DynamicStrings_char (s, (*i))) - { - case 'a': - o = x (o, doName (bol, sym, o, "es)); - break; - - case 'q': - o = x (o, doQualified (bol, sym, o)); - break; - - case 't': - o = x (o, doType (bol, &sym, o)); - break; - - case 'd': - o = x (o, doDesc (bol, sym, o, "es)); - break; - - case 'n': - o = x (o, doNumber (bol, sym, o, "es)); - break; - - case 'N': - o = x (o, doCount (bol, sym, o, "es)); - break; - - case 's': - o = x (o, doSkipType (bol, &sym, o)); - break; - - case 'k': - o = x (o, doKey (bol, sym, o)); - break; - - case 'D': - (*e) = doDeclaredDef ((*e), (*t), bol, sym); - break; - - case 'M': - (*e) = doDeclaredMod ((*e), (*t), bol, sym); - break; - - case 'U': - (*e) = doUsed ((*e), (*t), bol, sym); - break; - - case 'E': - (*t) = mcMetaError_newerror; - break; - - case 'W': - (*t) = mcMetaError_newwarning; - break; - - case ':': - varargs_end (&sym); - sym = varargs_copy (c); - then (e, t, r, s, sym, i, l, o, positive); - o = DynamicStrings_KillString (o); - o = DynamicStrings_InitString ((const char *) "", 0); - if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}')) - { - internalFormat (s, (*i), (const char *) "expecting to see }", 18); - } - (*i) -= 1; - break; - - - default: - internalFormat (s, (*i), (const char *) "expecting one of [aqtdnNsDUEW:]", 31); - break; - } - (*i) += 1; - } - (*r) = x ((*r), addQuoted ((*r), o, quotes)); - o = DynamicStrings_KillString (o); -} - - -/* - percenttoken := '%' ( - '1' % doOperand(1) % - op - | '2' % doOperand(2) % - op - | '3' % doOperand(3) % - op - | '4' % doOperand(4) % - op - ) - } =: -*/ - -static void percenttoken (mcError_error *e, mcMetaError_errorType t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, unsigned int positive) -{ - if ((DynamicStrings_char (s, (*i))) == '%') - { - (*i) += 1; - switch (DynamicStrings_char (s, (*i))) - { - case '1': - (*i) += 1; - op (e, &t, r, s, sym, i, l, 0, positive); - break; - - case '2': - (*i) += 1; - op (e, &t, r, s, sym, i, l, 1, positive); - break; - - case '3': - (*i) += 1; - op (e, &t, r, s, sym, i, l, 2, positive); - break; - - case '4': - (*i) += 1; - op (e, &t, r, s, sym, i, l, 3, positive); - break; - - - default: - internalFormat (s, (*i), (const char *) "expecting one of [123]", 22); - break; - } - if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}')) - { - internalFormat (s, (*i), (const char *) "expecting to see }", 18); - } - } -} - - -/* - percent := '%' anych % copy anych % - =: -*/ - -static void percent (DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l) -{ - if ((DynamicStrings_char (s, (*i))) == '%') - { - (*i) += 1; - if ((*i) < l) - { - (*r) = x ((*r), DynamicStrings_ConCatChar ((*r), DynamicStrings_char (s, (*i)))); - (*i) += 1; - } - } -} - - -/* - lbra := '{' [ '!' ] percenttoken '}' =: -*/ - -static void lbra (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l) -{ - unsigned int positive; - - if ((DynamicStrings_char (s, (*i))) == '{') - { - positive = TRUE; - (*i) += 1; - if ((DynamicStrings_char (s, (*i))) == '!') - { - positive = FALSE; - (*i) += 1; - } - if ((DynamicStrings_char (s, (*i))) != '%') - { - internalFormat (s, (*i), (const char *) "expecting to see %", 18); - } - percenttoken (e, (*t), r, s, sym, i, l, positive); - if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}')) - { - internalFormat (s, (*i), (const char *) "expecting to see }", 18); - } - } -} - - -/* - lbra := '{' [ '!' ] percenttoken '}' =: -*/ - -static void stop (void) -{ -} - - -/* - ebnf := { percent - | lbra - | any % copy ch % - } - =: -*/ - -static void ebnf (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l) -{ - while ((*i) < l) - { - switch (DynamicStrings_char (s, (*i))) - { - case '%': - percent (r, s, sym, i, l); - break; - - case '{': - lbra (e, t, r, s, sym, i, l); - if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}')) - { - internalFormat (s, (*i), (const char *) "expecting to see }", 18); - } - break; - - case '}': - return ; - break; - - - default: - if ((((isWhite (DynamicStrings_char (s, (*i)))) && ((DynamicStrings_Length ((*r))) > 0)) && (! (isWhite (DynamicStrings_char ((*r), -1))))) || (! (isWhite (DynamicStrings_char (s, (*i)))))) - { - (*r) = x ((*r), DynamicStrings_ConCatChar ((*r), DynamicStrings_char (s, (*i)))); - } - break; - } - (*i) += 1; - } -} - - -/* - doFormat - -*/ - -static DynamicStrings_String doFormat (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String s, varargs_vararg sym) -{ - DynamicStrings_String r; - int i; - int l; - - r = DynamicStrings_InitString ((const char *) "", 0); - i = 0; - l = DynamicStrings_Length (s); - ebnf (e, t, &r, s, sym, &i, l); - s = DynamicStrings_KillString (s); - return r; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - wrapErrors - -*/ - -static void wrapErrors (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, varargs_vararg sym) -{ - mcError_error e; - mcError_error f; - DynamicStrings_String str; - mcMetaError_errorType t; - char m1[_m1_high+1]; - char m2[_m2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - - e = static_cast (NULL); - t = mcMetaError_newerror; - str = doFormat (&e, &t, DynamicStrings_InitString ((const char *) m1, _m1_high), sym); - e = doError (e, t, tok); - mcError_errorString (e, str); - f = e; - t = mcMetaError_chained; - str = doFormat (&f, &t, DynamicStrings_InitString ((const char *) m2, _m2_high), sym); - if (e == f) - { - t = mcMetaError_chained; - f = doError (e, t, tok); - } - mcError_errorString (f, str); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high) -{ - char m[_m_high+1]; - unsigned char s[_s_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - memcpy (s, s_, _s_high+1); - - mcMetaError_metaErrorT1 (mcLexBuf_getTokenNo (), (const char *) m, _m_high, (const unsigned char *) s, _s_high); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaError2 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high) -{ - char m[_m_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - - mcMetaError_metaErrorT2 (mcLexBuf_getTokenNo (), (const char *) m, _m_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaError3 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high) -{ - char m[_m_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - - mcMetaError_metaErrorT3 (mcLexBuf_getTokenNo (), (const char *) m, _m_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaError4 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high) -{ - char m[_m_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - unsigned char s4[_s4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - memcpy (s4, s4_, _s4_high+1); - - mcMetaError_metaErrorT4 (mcLexBuf_getTokenNo (), (const char *) m, _m_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrors1 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high) -{ - char m1[_m1_high+1]; - char m2[_m2_high+1]; - unsigned char s[_s_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - memcpy (s, s_, _s_high+1); - - mcMetaError_metaErrorsT1 (mcLexBuf_getTokenNo (), (const char *) m1, _m1_high, (const char *) m2, _m2_high, (const unsigned char *) s, _s_high); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrors2 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high) -{ - char m1[_m1_high+1]; - char m2[_m2_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - - mcMetaError_metaErrorsT2 (mcLexBuf_getTokenNo (), (const char *) m1, _m1_high, (const char *) m2, _m2_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrors3 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high) -{ - char m1[_m1_high+1]; - char m2[_m2_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - - mcMetaError_metaErrorsT3 (mcLexBuf_getTokenNo (), (const char *) m1, _m1_high, (const char *) m2, _m2_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrors4 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high) -{ - char m1[_m1_high+1]; - char m2[_m2_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - unsigned char s4[_s4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - memcpy (s4, s4_, _s4_high+1); - - mcMetaError_metaErrorsT4 (mcLexBuf_getTokenNo (), (const char *) m1, _m1_high, (const char *) m2, _m2_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high) -{ - char m[_m_high+1]; - unsigned char s[_s_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - memcpy (s, s_, _s_high+1); - - mcMetaError_metaErrorStringT1 (tok, DynamicStrings_InitString ((const char *) m, _m_high), (const unsigned char *) s, _s_high); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorT2 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high) -{ - char m[_m_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - - mcMetaError_metaErrorStringT2 (tok, DynamicStrings_InitString ((const char *) m, _m_high), (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorT3 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high) -{ - char m[_m_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - - mcMetaError_metaErrorStringT3 (tok, DynamicStrings_InitString ((const char *) m, _m_high), (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorT4 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high) -{ - char m[_m_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - unsigned char s4[_s4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m, m_, _m_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - memcpy (s4, s4_, _s4_high+1); - - mcMetaError_metaErrorStringT4 (tok, DynamicStrings_InitString ((const char *) m, _m_high), (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorsT1 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high) -{ - varargs_vararg sym; - char m1[_m1_high+1]; - char m2[_m2_high+1]; - unsigned char s[_s_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - memcpy (s, s_, _s_high+1); - - sym = varargs_start1 ((const unsigned char *) s, _s_high); - wrapErrors (tok, (const char *) m1, _m1_high, (const char *) m2, _m2_high, sym); - varargs_end (&sym); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorsT2 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high) -{ - varargs_vararg sym; - char m1[_m1_high+1]; - char m2[_m2_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - - sym = varargs_start2 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high); - wrapErrors (tok, (const char *) m1, _m1_high, (const char *) m2, _m2_high, sym); - varargs_end (&sym); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorsT3 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high) -{ - varargs_vararg sym; - char m1[_m1_high+1]; - char m2[_m2_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - - sym = varargs_start3 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high); - wrapErrors (tok, (const char *) m1, _m1_high, (const char *) m2, _m2_high, sym); - varargs_end (&sym); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorsT4 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high) -{ - varargs_vararg sym; - char m1[_m1_high+1]; - char m2[_m2_high+1]; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - unsigned char s4[_s4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (m1, m1_, _m1_high+1); - memcpy (m2, m2_, _m2_high+1); - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - memcpy (s4, s4_, _s4_high+1); - - sym = varargs_start4 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high); - wrapErrors (tok, (const char *) m1, _m1_high, (const char *) m2, _m2_high, sym); - varargs_end (&sym); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high) -{ - unsigned char s[_s_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s, s_, _s_high+1); - - mcMetaError_metaErrorStringT1 (mcLexBuf_getTokenNo (), m, (const unsigned char *) s, _s_high); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high) -{ - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - - mcMetaError_metaErrorStringT2 (mcLexBuf_getTokenNo (), m, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorString3 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high) -{ - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - - mcMetaError_metaErrorStringT3 (mcLexBuf_getTokenNo (), m, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high); -} - - -/* - wrapErrors - -*/ - -extern "C" void mcMetaError_metaErrorString4 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high) -{ - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - unsigned char s4[_s4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - memcpy (s4, s4_, _s4_high+1); - - mcMetaError_metaErrorStringT4 (mcLexBuf_getTokenNo (), m, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high) -{ - DynamicStrings_String str; - mcError_error e; - varargs_vararg sym; - mcMetaError_errorType t; - unsigned char s[_s_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s, s_, _s_high+1); - - e = static_cast (NULL); - sym = varargs_start1 ((const unsigned char *) s, _s_high); - t = mcMetaError_newerror; - str = doFormat (&e, &t, m, sym); - e = doError (e, t, tok); - mcError_errorString (e, str); - varargs_end (&sym); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorStringT2 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high) -{ - DynamicStrings_String str; - mcError_error e; - varargs_vararg sym; - mcMetaError_errorType t; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - - e = static_cast (NULL); - sym = varargs_start2 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high); - t = mcMetaError_newerror; - str = doFormat (&e, &t, m, sym); - e = doError (e, t, tok); - mcError_errorString (e, str); - varargs_end (&sym); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorStringT3 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high) -{ - DynamicStrings_String str; - mcError_error e; - varargs_vararg sym; - mcMetaError_errorType t; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - - e = static_cast (NULL); - sym = varargs_start3 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high); - t = mcMetaError_newerror; - str = doFormat (&e, &t, m, sym); - e = doError (e, t, tok); - mcError_errorString (e, str); - varargs_end (&sym); -} - - -/* - doFormat - -*/ - -extern "C" void mcMetaError_metaErrorStringT4 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high) -{ - DynamicStrings_String str; - mcError_error e; - varargs_vararg sym; - mcMetaError_errorType t; - unsigned char s1[_s1_high+1]; - unsigned char s2[_s2_high+1]; - unsigned char s3[_s3_high+1]; - unsigned char s4[_s4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s1, s1_, _s1_high+1); - memcpy (s2, s2_, _s2_high+1); - memcpy (s3, s3_, _s3_high+1); - memcpy (s4, s4_, _s4_high+1); - - e = static_cast (NULL); - sym = varargs_start4 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high); - t = mcMetaError_newerror; - str = doFormat (&e, &t, m, sym); - e = doError (e, t, tok); - mcError_errorString (e, str); - varargs_end (&sym); -} - -extern "C" void _M2_mcMetaError_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcMetaError_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcOptions.c b/gcc/m2/mc-boot/GmcOptions.c deleted file mode 100644 index 5d4e31be5a7a..000000000000 --- a/gcc/m2/mc-boot/GmcOptions.c +++ /dev/null @@ -1,1122 +0,0 @@ -/* do not edit automatically generated by mc from mcOptions. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcOptions_H -#define _mcOptions_C - -# include "GSArgs.h" -# include "GmcSearch.h" -# include "Glibc.h" -# include "GmcPrintf.h" -# include "GDebug.h" -# include "GStrLib.h" -# include "Gdecl.h" -# include "GDynamicStrings.h" -# include "GFIO.h" -# include "GSFIO.h" - -static unsigned int langC; -static unsigned int langCPP; -static unsigned int langM2; -static unsigned int gplHeader; -static unsigned int glplHeader; -static unsigned int summary; -static unsigned int contributed; -static unsigned int scaffoldMain; -static unsigned int scaffoldDynamic; -static unsigned int caseRuntime; -static unsigned int arrayRuntime; -static unsigned int returnRuntime; -static unsigned int suppressNoReturn; -static unsigned int gccConfigSystem; -static unsigned int ignoreFQ; -static unsigned int debugTopological; -static unsigned int extendedOpaque; -static unsigned int internalDebugging; -static unsigned int verbose; -static unsigned int quiet; -static DynamicStrings_String projectContents; -static DynamicStrings_String summaryContents; -static DynamicStrings_String contributedContents; -static DynamicStrings_String hPrefix; -static DynamicStrings_String outputFile; -static DynamicStrings_String cppArgs; -static DynamicStrings_String cppProgram; - -/* - handleOptions - iterates over all options setting appropriate - values and returns the single source file - if found at the end of the arguments. -*/ - -extern "C" DynamicStrings_String mcOptions_handleOptions (void); - -/* - getQuiet - return the value of quiet. -*/ - -extern "C" unsigned int mcOptions_getQuiet (void); - -/* - getVerbose - return the value of verbose. -*/ - -extern "C" unsigned int mcOptions_getVerbose (void); - -/* - getInternalDebugging - return the value of internalDebugging. -*/ - -extern "C" unsigned int mcOptions_getInternalDebugging (void); - -/* - getCppCommandLine - returns the Cpp command line and all arguments. -*/ - -extern "C" DynamicStrings_String mcOptions_getCppCommandLine (void); - -/* - getOutputFile - sets the output filename to output. -*/ - -extern "C" DynamicStrings_String mcOptions_getOutputFile (void); - -/* - getExtendedOpaque - return the extendedOpaque value. -*/ - -extern "C" unsigned int mcOptions_getExtendedOpaque (void); - -/* - setDebugTopological - sets the flag debugTopological to value. -*/ - -extern "C" void mcOptions_setDebugTopological (unsigned int value); - -/* - getDebugTopological - returns the flag value of the command - line option --debug-top. -*/ - -extern "C" unsigned int mcOptions_getDebugTopological (void); - -/* - getHPrefix - saves the H file prefix. -*/ - -extern "C" DynamicStrings_String mcOptions_getHPrefix (void); - -/* - getIgnoreFQ - returns the ignorefq flag. -*/ - -extern "C" unsigned int mcOptions_getIgnoreFQ (void); - -/* - getGccConfigSystem - return the value of the gccConfigSystem flag. -*/ - -extern "C" unsigned int mcOptions_getGccConfigSystem (void); - -/* - getScaffoldDynamic - return true if the --scaffold-dynamic option was present. -*/ - -extern "C" unsigned int mcOptions_getScaffoldDynamic (void); - -/* - getScaffoldMain - return true if the --scaffold-main option was present. -*/ - -extern "C" unsigned int mcOptions_getScaffoldMain (void); - -/* - writeGPLheader - writes out the GPL or the LGPL as a comment. -*/ - -extern "C" void mcOptions_writeGPLheader (FIO_File f); - -/* - setSuppressNoReturn - set suppressNoReturn to value. -*/ - -extern "C" void mcOptions_setSuppressNoReturn (unsigned int value); - -/* - getSuppressNoReturn - return the suppressNoReturn value. -*/ - -extern "C" unsigned int mcOptions_getSuppressNoReturn (void); - -/* - getYear - return the year. -*/ - -static unsigned int getYear (void); - -/* - displayVersion - displays the version of the compiler. -*/ - -static void displayVersion (unsigned int mustExit); - -/* - displayHelp - display the mc help summary. -*/ - -static void displayHelp (void); - -/* - commentBegin - issue a start of comment for the appropriate language. -*/ - -static void commentBegin (FIO_File f); - -/* - commentEnd - issue an end of comment for the appropriate language. -*/ - -static void commentEnd (FIO_File f); - -/* - comment - write a comment to file, f, and also a newline. -*/ - -static void comment (FIO_File f, const char *a_, unsigned int _a_high); - -/* - commentS - write a comment to file, f, and also a newline. -*/ - -static void commentS (FIO_File f, DynamicStrings_String s); - -/* - gplBody - -*/ - -static void gplBody (FIO_File f); - -/* - glplBody - -*/ - -static void glplBody (FIO_File f); - -/* - issueGPL - writes out the summary, GPL/LGPL and/or contributed as a single comment. -*/ - -static void issueGPL (FIO_File f); - -/* - setOutputFile - sets the output filename to output. -*/ - -static void setOutputFile (DynamicStrings_String output); - -/* - setQuiet - sets the quiet flag to, value. -*/ - -static void setQuiet (unsigned int value); - -/* - setVerbose - sets the verbose flag to, value. -*/ - -static void setVerbose (unsigned int value); - -/* - setExtendedOpaque - set extendedOpaque to value. -*/ - -static void setExtendedOpaque (unsigned int value); - -/* - setSearchPath - set the search path for the module sources. -*/ - -static void setSearchPath (DynamicStrings_String arg); - -/* - setInternalDebugging - turn on/off internal debugging. -*/ - -static void setInternalDebugging (unsigned int value); - -/* - setHPrefix - saves the H file prefix. -*/ - -static void setHPrefix (DynamicStrings_String s); - -/* - setIgnoreFQ - sets the ignorefq flag. -*/ - -static void setIgnoreFQ (unsigned int value); - -/* - optionIs - returns TRUE if the first len (right) characters - match left. -*/ - -static unsigned int optionIs (const char *left_, unsigned int _left_high, DynamicStrings_String right); - -/* - setLang - set the appropriate output language. -*/ - -static void setLang (DynamicStrings_String arg); - -/* - handleOption - -*/ - -static void handleOption (DynamicStrings_String arg); - - -/* - getYear - return the year. -*/ - -static unsigned int getYear (void) -{ - libc_time_t epoch; - libc_ptrToTM localTime; - - epoch = libc_time (NULL); - localTime = static_cast (libc_localtime (&epoch)); - return localTime->tm_year+1900; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - displayVersion - displays the version of the compiler. -*/ - -static void displayVersion (unsigned int mustExit) -{ - unsigned int year; - - year = getYear (); - /* These first three calls to printf hide the first line of text away from the year change script. */ - mcPrintf_printf0 ((const char *) "Copyright ", 10); - mcPrintf_printf0 ((const char *) "(C)", 3); /* A unicode char here would be good. */ - mcPrintf_printf1 ((const char *) " %d Free Software Foundation, Inc.\\n", 36, (const unsigned char *) &year, (sizeof (year)-1)); /* A unicode char here would be good. */ - mcPrintf_printf0 ((const char *) "License GPLv3: GNU GPL version 3 or later \\n", 78); - mcPrintf_printf0 ((const char *) "This is free software: you are free to change and redistribute it.\\n", 68); - mcPrintf_printf0 ((const char *) "There is NO WARRANTY, to the extent permitted by law.\\n", 55); - if (mustExit) - { - libc_exit (0); - } -} - - -/* - displayHelp - display the mc help summary. -*/ - -static void displayHelp (void) -{ - mcPrintf_printf0 ((const char *) "usage: mc [--cpp] [-g] [--quiet] [--extended-opaque] [-q] [-v]", 62); - mcPrintf_printf0 ((const char *) " [--verbose] [--version] [--help] [-h] [-Ipath] [--olang=c]", 59); - mcPrintf_printf0 ((const char *) " [--olang=c++] [--olang=m2] [--debug-top]", 41); - mcPrintf_printf0 ((const char *) " [--gpl-header] [--glpl-header] [--summary=\"foo\"]", 49); - mcPrintf_printf0 ((const char *) " [--contributed=\"foo\"] [--project=\"foo\"]", 40); - mcPrintf_printf0 ((const char *) " [--h-file-prefix=foo] [--automatic] [-o=foo] filename\\n", 56); - mcPrintf_printf0 ((const char *) " --cpp preprocess through the C preprocessor\\n", 61); - mcPrintf_printf0 ((const char *) " -g emit debugging directives in the output language", 70); - mcPrintf_printf0 ((const char *) " so that the debugger will refer to the source\\n", 69); - mcPrintf_printf0 ((const char *) " -q --quiet no output unless an error occurs\\n", 56); - mcPrintf_printf0 ((const char *) " -v --verbose display preprocessor if invoked\\n", 55); - mcPrintf_printf0 ((const char *) " --version display version and exit\\n", 48); - mcPrintf_printf0 ((const char *) " -h --help display this help message\\n", 49); - mcPrintf_printf0 ((const char *) " -Ipath set the module search path\\n", 50); - mcPrintf_printf0 ((const char *) " --olang=c generate ansi C output\\n", 46); - mcPrintf_printf0 ((const char *) " --olang=c++ generate ansi C++ output\\n", 48); - mcPrintf_printf0 ((const char *) " --olang=m2 generate PIM4 output\\n", 44); - mcPrintf_printf0 ((const char *) " --extended-opaque parse definition and implementation modules to\\n", 70); - mcPrintf_printf0 ((const char *) " generate full type debugging of opaque types\\n", 68); - mcPrintf_printf0 ((const char *) " --debug-top debug topological data structure resolving (internal)\\n", 77); - mcPrintf_printf0 ((const char *) " --h-file-prefix=foo set the h file prefix to foo\\n", 52); - mcPrintf_printf0 ((const char *) " -o=foo set the output file to foo\\n", 50); - mcPrintf_printf0 ((const char *) " --ignore-fq do not generate fully qualified idents\\n", 62); - mcPrintf_printf0 ((const char *) " --gcc-config-system do not use standard host include files, use gcc config and system instead\\n", 97); - mcPrintf_printf0 ((const char *) " --gpl-header generate a GPL3 header comment at the top of the file\\n", 77); - mcPrintf_printf0 ((const char *) " --glpl-header generate a GLPL3 header comment at the top of the file\\n", 78); - mcPrintf_printf0 ((const char *) " --summary=\"foo\" generate a one line summary comment at the top of the file\\n", 82); - mcPrintf_printf0 ((const char *) " --contributed=\"foo\" generate a one line contribution comment near the top of the file\\n", 89); - mcPrintf_printf0 ((const char *) " --project=\"foo\" include the project name within the GPL3 or GLPL3 header\\n", 80); - mcPrintf_printf0 ((const char *) " --automatic generate a comment at the start of the file warning not to edit as it was automatically generated\\n", 121); - mcPrintf_printf0 ((const char *) " --scaffold-dynamic generate dynamic module initialization code for C++\\n", 75); - mcPrintf_printf0 ((const char *) " --scaffold-main generate main function which calls upon the dynamic initialization support in M2RTS\\n", 107); - mcPrintf_printf0 ((const char *) " --suppress-noreturn suppress the emission of any attribute noreturn\\n", 71); - mcPrintf_printf0 ((const char *) " filename the source file must be the last option\\n", 63); - libc_exit (0); -} - - -/* - commentBegin - issue a start of comment for the appropriate language. -*/ - -static void commentBegin (FIO_File f) -{ - if (langC || langCPP) - { - FIO_WriteString (f, (const char *) "/* ", 3); - } - else if (langM2) - { - /* avoid dangling else. */ - FIO_WriteString (f, (const char *) "(* ", 3); - } -} - - -/* - commentEnd - issue an end of comment for the appropriate language. -*/ - -static void commentEnd (FIO_File f) -{ - if (langC || langCPP) - { - FIO_WriteString (f, (const char *) " */", 3); - FIO_WriteLine (f); - } - else if (langM2) - { - /* avoid dangling else. */ - FIO_WriteString (f, (const char *) " *)", 3); - FIO_WriteLine (f); - } -} - - -/* - comment - write a comment to file, f, and also a newline. -*/ - -static void comment (FIO_File f, const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - FIO_WriteString (f, (const char *) a, _a_high); - FIO_WriteLine (f); -} - - -/* - commentS - write a comment to file, f, and also a newline. -*/ - -static void commentS (FIO_File f, DynamicStrings_String s) -{ - s = SFIO_WriteS (f, s); - FIO_WriteLine (f); -} - - -/* - gplBody - -*/ - -static void gplBody (FIO_File f) -{ - unsigned int year; - - year = getYear (); - mcPrintf_printf1 ((const char *) "Copyright (C) %d Free Software Foundation, Inc.\\n", 49, (const unsigned char *) &year, (sizeof (year)-1)); - if (contributed) - { - FIO_WriteString (f, (const char *) "Contributed by ", 15); - contributedContents = SFIO_WriteS (f, contributedContents); - FIO_WriteString (f, (const char *) ".", 1); - FIO_WriteLine (f); - } - FIO_WriteLine (f); - FIO_WriteString (f, (const char *) "This file is part of ", 21); - projectContents = SFIO_WriteS (f, projectContents); - FIO_WriteString (f, (const char *) ".", 1); - FIO_WriteLine (f); - FIO_WriteLine (f); - projectContents = SFIO_WriteS (f, projectContents); - comment (f, (const char *) " is software; you can redistribute it and/or modify", 51); - comment (f, (const char *) "it under the terms of the GNU General Public License as published by", 68); - comment (f, (const char *) "the Free Software Foundation; either version 3, or (at your option)", 67); - comment (f, (const char *) "any later version.", 18); - FIO_WriteLine (f); - projectContents = SFIO_WriteS (f, projectContents); - comment (f, (const char *) " is distributed in the hope that it will be useful, but", 55); - comment (f, (const char *) "WITHOUT ANY WARRANTY; without even the implied warranty of", 58); - comment (f, (const char *) "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU", 65); - comment (f, (const char *) "General Public License for more details.", 40); - FIO_WriteLine (f); - comment (f, (const char *) "You should have received a copy of the GNU General Public License", 65); - FIO_WriteString (f, (const char *) "along with ", 11); - projectContents = SFIO_WriteS (f, projectContents); - comment (f, (const char *) "; see the file COPYING. If not,", 32); - FIO_WriteString (f, (const char *) "see . ", 37); -} - - -/* - glplBody - -*/ - -static void glplBody (FIO_File f) -{ - unsigned int year; - - year = getYear (); - mcPrintf_printf1 ((const char *) "Copyright (C) %d Free Software Foundation, Inc.\\n", 49, (const unsigned char *) &year, (sizeof (year)-1)); - if (contributed) - { - FIO_WriteString (f, (const char *) "Contributed by ", 15); - contributedContents = SFIO_WriteS (f, contributedContents); - FIO_WriteString (f, (const char *) ".", 1); - FIO_WriteLine (f); - } - FIO_WriteLine (f); - FIO_WriteString (f, (const char *) "This file is part of ", 21); - projectContents = SFIO_WriteS (f, projectContents); - FIO_WriteString (f, (const char *) ".", 1); - FIO_WriteLine (f); - FIO_WriteLine (f); - projectContents = SFIO_WriteS (f, projectContents); - comment (f, (const char *) " is free software; you can redistribute it and/or modify", 56); - comment (f, (const char *) "it under the terms of the GNU General Public License as published by", 68); - comment (f, (const char *) "the Free Software Foundation; either version 3, or (at your option)", 67); - comment (f, (const char *) "any later version.", 18); - FIO_WriteLine (f); - projectContents = SFIO_WriteS (f, projectContents); - comment (f, (const char *) " is software; you can redistribute it and/or modify", 51); - comment (f, (const char *) "it under the terms of the GNU Lesser General Public License", 59); - comment (f, (const char *) "as published by the Free Software Foundation; either version 3,", 63); - comment (f, (const char *) "or (at your option) any later version.", 38); - FIO_WriteLine (f); - projectContents = SFIO_WriteS (f, projectContents); - comment (f, (const char *) " is distributed in the hope that it will be useful, but", 55); - comment (f, (const char *) "WITHOUT ANY WARRANTY; without even the implied warranty of", 58); - comment (f, (const char *) "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU", 65); - comment (f, (const char *) "General Public License for more details.", 40); - FIO_WriteLine (f); - comment (f, (const char *) "You should have received a copy of the GNU General Public License", 65); - FIO_WriteString (f, (const char *) "along with ", 11); - projectContents = SFIO_WriteS (f, projectContents); - comment (f, (const char *) "; see the file COPYING3. If not see", 36); - comment (f, (const char *) ".", 31); - FIO_WriteLine (f); - comment (f, (const char *) "You should have received a copy of the GNU Lesser General Public License", 72); - FIO_WriteString (f, (const char *) "along with ", 11); - projectContents = SFIO_WriteS (f, projectContents); - comment (f, (const char *) "; see the file COPYING. If not,", 32); - FIO_WriteString (f, (const char *) "see . ", 37); -} - - -/* - issueGPL - writes out the summary, GPL/LGPL and/or contributed as a single comment. -*/ - -static void issueGPL (FIO_File f) -{ - if (((summary || contributed) || gplHeader) || glplHeader) - { - commentBegin (f); - if (summary) - { - commentS (f, summaryContents); - FIO_WriteLine (f); - } - if (gplHeader) - { - gplBody (f); - } - if (glplHeader) - { - glplBody (f); - } - commentEnd (f); - FIO_WriteLine (f); - } -} - - -/* - setOutputFile - sets the output filename to output. -*/ - -static void setOutputFile (DynamicStrings_String output) -{ - outputFile = output; -} - - -/* - setQuiet - sets the quiet flag to, value. -*/ - -static void setQuiet (unsigned int value) -{ - quiet = value; -} - - -/* - setVerbose - sets the verbose flag to, value. -*/ - -static void setVerbose (unsigned int value) -{ - verbose = value; -} - - -/* - setExtendedOpaque - set extendedOpaque to value. -*/ - -static void setExtendedOpaque (unsigned int value) -{ - extendedOpaque = value; -} - - -/* - setSearchPath - set the search path for the module sources. -*/ - -static void setSearchPath (DynamicStrings_String arg) -{ - mcSearch_prependSearchPath (arg); -} - - -/* - setInternalDebugging - turn on/off internal debugging. -*/ - -static void setInternalDebugging (unsigned int value) -{ - internalDebugging = value; -} - - -/* - setHPrefix - saves the H file prefix. -*/ - -static void setHPrefix (DynamicStrings_String s) -{ - hPrefix = s; -} - - -/* - setIgnoreFQ - sets the ignorefq flag. -*/ - -static void setIgnoreFQ (unsigned int value) -{ - ignoreFQ = value; -} - - -/* - optionIs - returns TRUE if the first len (right) characters - match left. -*/ - -static unsigned int optionIs (const char *left_, unsigned int _left_high, DynamicStrings_String right) -{ - DynamicStrings_String s; - char left[_left_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (left, left_, _left_high+1); - - if ((DynamicStrings_Length (right)) == (StrLib_StrLen ((const char *) left, _left_high))) - { - return DynamicStrings_EqualArray (right, (const char *) left, _left_high); - } - else if ((DynamicStrings_Length (right)) > (StrLib_StrLen ((const char *) left, _left_high))) - { - /* avoid dangling else. */ - s = DynamicStrings_Mark (DynamicStrings_Slice (right, 0, static_cast (StrLib_StrLen ((const char *) left, _left_high)))); - return DynamicStrings_EqualArray (s, (const char *) left, _left_high); - } - else - { - /* avoid dangling else. */ - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setLang - set the appropriate output language. -*/ - -static void setLang (DynamicStrings_String arg) -{ - /* must check the longest distinctive string first. */ - if (optionIs ((const char *) "c++", 3, arg)) - { - decl_setLangCP (); - langCPP = TRUE; - } - else if (optionIs ((const char *) "c", 1, arg)) - { - /* avoid dangling else. */ - decl_setLangC (); - langC = TRUE; - } - else if (optionIs ((const char *) "m2", 2, arg)) - { - /* avoid dangling else. */ - decl_setLangM2 (); - langM2 = TRUE; - } - else - { - /* avoid dangling else. */ - displayHelp (); - } -} - - -/* - handleOption - -*/ - -static void handleOption (DynamicStrings_String arg) -{ - if ((optionIs ((const char *) "--quiet", 7, arg)) || (optionIs ((const char *) "-q", 2, arg))) - { - setQuiet (TRUE); - } - else if ((optionIs ((const char *) "--verbose", 9, arg)) || (optionIs ((const char *) "-v", 2, arg))) - { - /* avoid dangling else. */ - setVerbose (TRUE); - } - else if (optionIs ((const char *) "--version", 9, arg)) - { - /* avoid dangling else. */ - displayVersion (TRUE); - } - else if (optionIs ((const char *) "--olang=", 8, arg)) - { - /* avoid dangling else. */ - setLang (DynamicStrings_Slice (arg, 8, 0)); - } - else if (optionIs ((const char *) "-I", 2, arg)) - { - /* avoid dangling else. */ - setSearchPath (DynamicStrings_Slice (arg, 2, 0)); - } - else if ((optionIs ((const char *) "--help", 6, arg)) || (optionIs ((const char *) "-h", 2, arg))) - { - /* avoid dangling else. */ - displayHelp (); - } - else if (optionIs ((const char *) "--cpp", 5, arg)) - { - /* avoid dangling else. */ - cppProgram = DynamicStrings_InitString ((const char *) "cpp", 3); - } - else if (optionIs ((const char *) "-o=", 3, arg)) - { - /* avoid dangling else. */ - setOutputFile (DynamicStrings_Slice (arg, 3, 0)); - } - else if (optionIs ((const char *) "--extended-opaque", 17, arg)) - { - /* avoid dangling else. */ - setExtendedOpaque (TRUE); - } - else if (optionIs ((const char *) "--debug-top", 11, arg)) - { - /* avoid dangling else. */ - mcOptions_setDebugTopological (TRUE); - } - else if (optionIs ((const char *) "--h-file-prefix=", 16, arg)) - { - /* avoid dangling else. */ - setHPrefix (DynamicStrings_Slice (arg, 16, 0)); - } - else if (optionIs ((const char *) "--ignore-fq", 11, arg)) - { - /* avoid dangling else. */ - setIgnoreFQ (TRUE); - } - else if (optionIs ((const char *) "--gpl-header", 12, arg)) - { - /* avoid dangling else. */ - gplHeader = TRUE; - } - else if (optionIs ((const char *) "--glpl-header", 13, arg)) - { - /* avoid dangling else. */ - glplHeader = TRUE; - } - else if (optionIs ((const char *) "--summary=\"", 11, arg)) - { - /* avoid dangling else. */ - summary = TRUE; - summaryContents = DynamicStrings_Slice (arg, 11, -1); - } - else if (optionIs ((const char *) "--contributed=\"", 15, arg)) - { - /* avoid dangling else. */ - contributed = TRUE; - contributedContents = DynamicStrings_Slice (arg, 13, -1); - } - else if (optionIs ((const char *) "--project=\"", 11, arg)) - { - /* avoid dangling else. */ - projectContents = DynamicStrings_Slice (arg, 10, -1); - } - else if (optionIs ((const char *) "--gcc-config-system", 19, arg)) - { - /* avoid dangling else. */ - gccConfigSystem = TRUE; - } - else if (optionIs ((const char *) "--scaffold-main", 15, arg)) - { - /* avoid dangling else. */ - scaffoldMain = TRUE; - } - else if (optionIs ((const char *) "--scaffold-dynamic", 18, arg)) - { - /* avoid dangling else. */ - scaffoldDynamic = TRUE; - } - else if (optionIs ((const char *) "--suppress-noreturn", 19, arg)) - { - /* avoid dangling else. */ - suppressNoReturn = TRUE; - } -} - - -/* - handleOptions - iterates over all options setting appropriate - values and returns the single source file - if found at the end of the arguments. -*/ - -extern "C" DynamicStrings_String mcOptions_handleOptions (void) -{ - unsigned int i; - DynamicStrings_String arg; - - i = 1; - while (SArgs_GetArg (&arg, i)) - { - if ((DynamicStrings_Length (arg)) > 0) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((DynamicStrings_char (arg, 0)) == '-') - { - handleOption (arg); - } - else - { - if (! summary) - { - summaryContents = DynamicStrings_ConCatChar (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "automatically created by mc from ", 33), arg), '.'); - summary = FALSE; - } - return arg; - } - } - i += 1; - } - return static_cast (NULL); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getQuiet - return the value of quiet. -*/ - -extern "C" unsigned int mcOptions_getQuiet (void) -{ - return quiet; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getVerbose - return the value of verbose. -*/ - -extern "C" unsigned int mcOptions_getVerbose (void) -{ - return verbose; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getInternalDebugging - return the value of internalDebugging. -*/ - -extern "C" unsigned int mcOptions_getInternalDebugging (void) -{ - return internalDebugging; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getCppCommandLine - returns the Cpp command line and all arguments. -*/ - -extern "C" DynamicStrings_String mcOptions_getCppCommandLine (void) -{ - DynamicStrings_String s; - - if (DynamicStrings_EqualArray (cppProgram, (const char *) "", 0)) - { - return static_cast (NULL); - } - else - { - s = DynamicStrings_Dup (cppProgram); - s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (s, ' '), cppArgs); - if (mcOptions_getQuiet ()) - { - s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (s, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-quiet", 6))); - } - return s; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getOutputFile - sets the output filename to output. -*/ - -extern "C" DynamicStrings_String mcOptions_getOutputFile (void) -{ - return outputFile; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getExtendedOpaque - return the extendedOpaque value. -*/ - -extern "C" unsigned int mcOptions_getExtendedOpaque (void) -{ - return extendedOpaque; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setDebugTopological - sets the flag debugTopological to value. -*/ - -extern "C" void mcOptions_setDebugTopological (unsigned int value) -{ - debugTopological = value; -} - - -/* - getDebugTopological - returns the flag value of the command - line option --debug-top. -*/ - -extern "C" unsigned int mcOptions_getDebugTopological (void) -{ - return debugTopological; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getHPrefix - saves the H file prefix. -*/ - -extern "C" DynamicStrings_String mcOptions_getHPrefix (void) -{ - return hPrefix; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getIgnoreFQ - returns the ignorefq flag. -*/ - -extern "C" unsigned int mcOptions_getIgnoreFQ (void) -{ - return ignoreFQ; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getGccConfigSystem - return the value of the gccConfigSystem flag. -*/ - -extern "C" unsigned int mcOptions_getGccConfigSystem (void) -{ - return gccConfigSystem; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getScaffoldDynamic - return true if the --scaffold-dynamic option was present. -*/ - -extern "C" unsigned int mcOptions_getScaffoldDynamic (void) -{ - return scaffoldDynamic; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getScaffoldMain - return true if the --scaffold-main option was present. -*/ - -extern "C" unsigned int mcOptions_getScaffoldMain (void) -{ - return scaffoldMain; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - writeGPLheader - writes out the GPL or the LGPL as a comment. -*/ - -extern "C" void mcOptions_writeGPLheader (FIO_File f) -{ - issueGPL (f); -} - - -/* - setSuppressNoReturn - set suppressNoReturn to value. -*/ - -extern "C" void mcOptions_setSuppressNoReturn (unsigned int value) -{ - suppressNoReturn = value; -} - - -/* - getSuppressNoReturn - return the suppressNoReturn value. -*/ - -extern "C" unsigned int mcOptions_getSuppressNoReturn (void) -{ - return suppressNoReturn; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcOptions_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - langC = TRUE; - langCPP = FALSE; - langM2 = FALSE; - gplHeader = FALSE; - glplHeader = FALSE; - summary = FALSE; - contributed = FALSE; - caseRuntime = FALSE; - arrayRuntime = FALSE; - returnRuntime = FALSE; - internalDebugging = FALSE; - quiet = FALSE; - verbose = FALSE; - extendedOpaque = FALSE; - debugTopological = FALSE; - ignoreFQ = FALSE; - gccConfigSystem = FALSE; - scaffoldMain = FALSE; - scaffoldDynamic = FALSE; - suppressNoReturn = FALSE; - hPrefix = DynamicStrings_InitString ((const char *) "", 0); - cppArgs = DynamicStrings_InitString ((const char *) "", 0); - cppProgram = DynamicStrings_InitString ((const char *) "", 0); - outputFile = DynamicStrings_InitString ((const char *) "-", 1); - summaryContents = DynamicStrings_InitString ((const char *) "", 0); - contributedContents = DynamicStrings_InitString ((const char *) "", 0); - projectContents = DynamicStrings_InitString ((const char *) "GNU Modula-2", 12); -} - -extern "C" void _M2_mcOptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcPreprocess.c b/gcc/m2/mc-boot/GmcPreprocess.c deleted file mode 100644 index 91a50939d800..000000000000 --- a/gcc/m2/mc-boot/GmcPreprocess.c +++ /dev/null @@ -1,181 +0,0 @@ -/* do not edit automatically generated by mc from mcPreprocess. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _mcPreprocess_H -#define _mcPreprocess_C - -# include "GSYSTEM.h" -# include "GDynamicStrings.h" -# include "Glibc.h" -# include "Galists.h" -# include "GM2RTS.h" -# include "GFIO.h" -# include "GmcPrintf.h" -# include "GmcOptions.h" - -static alists_alist listOfFiles; - -/* - preprocessModule - preprocess a file, filename, returning the new filename - of the preprocessed file. - Preprocessing will only occur if requested by the user. - If no preprocessing was requested then filename is returned. - If preprocessing occurs then a temporary file is created - and its name is returned. - All temporary files will be deleted when the compiler exits. -*/ - -extern "C" DynamicStrings_String mcPreprocess_preprocessModule (DynamicStrings_String filename); - -/* - makeTempFile - -*/ - -static DynamicStrings_String makeTempFile (DynamicStrings_String ext); - -/* - onExitDelete - -*/ - -static DynamicStrings_String onExitDelete (DynamicStrings_String filename); - -/* - removeFile - removes a single file, s. -*/ - -static void removeFile (void * a); - -/* - removeFiles - -*/ - -static void removeFiles (void); - - -/* - makeTempFile - -*/ - -static DynamicStrings_String makeTempFile (DynamicStrings_String ext) -{ - return DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "/tmp/mctemp.", 12), ext); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - onExitDelete - -*/ - -static DynamicStrings_String onExitDelete (DynamicStrings_String filename) -{ - alists_includeItemIntoList (listOfFiles, reinterpret_cast (DynamicStrings_Dup (filename))); - return filename; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - removeFile - removes a single file, s. -*/ - -static void removeFile (void * a) -{ - DynamicStrings_String s; - - s = static_cast (a); - if ((libc_unlink (DynamicStrings_string (s))) != 0) - {} /* empty. */ -} - - -/* - removeFiles - -*/ - -static void removeFiles (void) -{ - alists_foreachItemInListDo (listOfFiles, (alists_performOperation) {(alists_performOperation_t) removeFile}); -} - - -/* - preprocessModule - preprocess a file, filename, returning the new filename - of the preprocessed file. - Preprocessing will only occur if requested by the user. - If no preprocessing was requested then filename is returned. - If preprocessing occurs then a temporary file is created - and its name is returned. - All temporary files will be deleted when the compiler exits. -*/ - -extern "C" DynamicStrings_String mcPreprocess_preprocessModule (DynamicStrings_String filename) -{ - DynamicStrings_String tempfile; - DynamicStrings_String command; - DynamicStrings_String commandLine; - unsigned int pos; - - command = mcOptions_getCppCommandLine (); - if (DynamicStrings_EqualArray (command, (const char *) "", 0)) - { - return filename; - } - else - { - tempfile = DynamicStrings_InitStringCharStar (reinterpret_cast (makeTempFile (DynamicStrings_InitString ((const char *) "cpp", 3)))); - commandLine = DynamicStrings_Dup (command); - commandLine = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Dup (commandLine), ' '), filename), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " -o ", 4))), tempfile); - if (mcOptions_getVerbose ()) - { - mcPrintf_fprintf1 (FIO_StdOut, (const char *) "%s\\n", 4, (const unsigned char *) &commandLine, (sizeof (commandLine)-1)); - } - if ((libc_system (DynamicStrings_string (commandLine))) != 0) - { - mcPrintf_fprintf1 (FIO_StdErr, (const char *) "C preprocessor failed when preprocessing %s\\n", 45, (const unsigned char *) &filename, (sizeof (filename)-1)); - libc_exit (1); - } - commandLine = DynamicStrings_KillString (commandLine); - return onExitDelete (tempfile); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcPreprocess_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - listOfFiles = alists_initList (); - if (! (M2RTS_InstallTerminationProcedure ((PROC ) {(PROC_t) removeFiles}))) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - -extern "C" void _M2_mcPreprocess_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcPretty.c b/gcc/m2/mc-boot/GmcPretty.c deleted file mode 100644 index 1184514fd252..000000000000 --- a/gcc/m2/mc-boot/GmcPretty.c +++ /dev/null @@ -1,468 +0,0 @@ -/* do not edit automatically generated by mc from mcPretty. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcPretty_H -#define _mcPretty_C - -# include "GDynamicStrings.h" -# include "GStorage.h" - -typedef struct mcPretty_writeProc_p mcPretty_writeProc; - -typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc; - -typedef struct mcPretty__T1_r mcPretty__T1; - -typedef mcPretty__T1 *mcPretty_pretty; - -typedef void (*mcPretty_writeProc_t) (char); -struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; }; - -typedef void (*mcPretty_writeLnProc_t) (void); -struct mcPretty_writeLnProc_p { mcPretty_writeLnProc_t proc; }; - -struct mcPretty__T1_r { - mcPretty_writeProc write_; - mcPretty_writeLnProc writeln; - unsigned int needsSpace; - unsigned int needsIndent; - unsigned int seekPos; - unsigned int curLine; - unsigned int curPos; - unsigned int indent; - mcPretty_pretty stacked; - }; - - -/* - initPretty - initialise a pretty print data structure. -*/ - -extern "C" mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l); - -/* - dupPretty - duplicate a pretty print data structure. -*/ - -extern "C" mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p); - -/* - killPretty - destroy a pretty print data structure. - Post condition: p is assigned to NIL. -*/ - -extern "C" void mcPretty_killPretty (mcPretty_pretty *p); - -/* - pushPretty - duplicate, p. Push, p, and return the duplicate. -*/ - -extern "C" mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p); - -/* - popPretty - pops the pretty object from the stack. -*/ - -extern "C" mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p); - -/* - getindent - returns the current indent value. -*/ - -extern "C" unsigned int mcPretty_getindent (mcPretty_pretty p); - -/* - setindent - sets the current indent to, n. -*/ - -extern "C" void mcPretty_setindent (mcPretty_pretty p, unsigned int n); - -/* - getcurpos - returns the current cursor position. -*/ - -extern "C" unsigned int mcPretty_getcurpos (mcPretty_pretty s); - -/* - getseekpos - returns the seek position. -*/ - -extern "C" unsigned int mcPretty_getseekpos (mcPretty_pretty s); - -/* - getcurline - returns the current line number. -*/ - -extern "C" unsigned int mcPretty_getcurline (mcPretty_pretty s); -extern "C" void mcPretty_setNeedSpace (mcPretty_pretty s); - -/* - noSpace - unset needsSpace. -*/ - -extern "C" void mcPretty_noSpace (mcPretty_pretty s); - -/* - print - print a string using, p. -*/ - -extern "C" void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high); - -/* - prints - print a string using, p. -*/ - -extern "C" void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s); - -/* - raw - print out string, s, without any translation of - escape sequences. -*/ - -extern "C" void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s); - -/* - flushSpace - -*/ - -static void flushSpace (mcPretty_pretty p); - -/* - flushIndent - -*/ - -static void flushIndent (mcPretty_pretty p); - - -/* - flushSpace - -*/ - -static void flushSpace (mcPretty_pretty p) -{ - if (p->needsSpace) - { - (*p->write_.proc) (' '); - p->needsSpace = FALSE; - p->curPos += 1; - p->seekPos += 1; - } -} - - -/* - flushIndent - -*/ - -static void flushIndent (mcPretty_pretty p) -{ - unsigned int i; - - flushSpace (p); - if (p->needsIndent) - { - while (p->curPos < p->indent) - { - (*p->write_.proc) (' '); - p->curPos += 1; - p->seekPos += 1; - } - p->needsIndent = FALSE; - } -} - - -/* - initPretty - initialise a pretty print data structure. -*/ - -extern "C" mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l) -{ - mcPretty_pretty p; - - Storage_ALLOCATE ((void **) &p, sizeof (mcPretty__T1)); - p->write_ = w; - p->writeln = l; - p->needsSpace = FALSE; - p->needsIndent = FALSE; - p->curPos = 0; - p->curLine = 0; - p->seekPos = 0; - p->indent = 0; - p->stacked = NULL; - return p; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - dupPretty - duplicate a pretty print data structure. -*/ - -extern "C" mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p) -{ - mcPretty_pretty q; - - Storage_ALLOCATE ((void **) &q, sizeof (mcPretty__T1)); - (*q) = (*p); - return q; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - killPretty - destroy a pretty print data structure. - Post condition: p is assigned to NIL. -*/ - -extern "C" void mcPretty_killPretty (mcPretty_pretty *p) -{ - (*p) = NULL; - return ; - Storage_DEALLOCATE ((void **) &(*p), sizeof (mcPretty__T1)); - (*p) = NULL; -} - - -/* - pushPretty - duplicate, p. Push, p, and return the duplicate. -*/ - -extern "C" mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p) -{ - mcPretty_pretty q; - - q = mcPretty_dupPretty (p); - q->stacked = p; - return q; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - popPretty - pops the pretty object from the stack. -*/ - -extern "C" mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p) -{ - mcPretty_pretty q; - - q = p->stacked; - q->needsIndent = p->needsIndent; - q->needsSpace = p->needsSpace; - q->curPos = p->curPos; - q->seekPos = p->seekPos; - q->curLine = p->curLine; - mcPretty_killPretty (&p); - return q; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getindent - returns the current indent value. -*/ - -extern "C" unsigned int mcPretty_getindent (mcPretty_pretty p) -{ - return p->indent; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setindent - sets the current indent to, n. -*/ - -extern "C" void mcPretty_setindent (mcPretty_pretty p, unsigned int n) -{ - p->indent = n; -} - - -/* - getcurpos - returns the current cursor position. -*/ - -extern "C" unsigned int mcPretty_getcurpos (mcPretty_pretty s) -{ - if (s->needsSpace) - { - return s->curPos+1; - } - else - { - return s->curPos; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getseekpos - returns the seek position. -*/ - -extern "C" unsigned int mcPretty_getseekpos (mcPretty_pretty s) -{ - return s->seekPos; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getcurline - returns the current line number. -*/ - -extern "C" unsigned int mcPretty_getcurline (mcPretty_pretty s) -{ - return s->curLine; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void mcPretty_setNeedSpace (mcPretty_pretty s) -{ - /* - setneedSpace - sets needSpace flag to TRUE. - */ - s->needsSpace = TRUE; -} - - -/* - noSpace - unset needsSpace. -*/ - -extern "C" void mcPretty_noSpace (mcPretty_pretty s) -{ - s->needsSpace = FALSE; -} - - -/* - print - print a string using, p. -*/ - -extern "C" void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high) -{ - DynamicStrings_String s; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - s = DynamicStrings_InitString ((const char *) a, _a_high); - mcPretty_prints (p, s); - s = DynamicStrings_KillString (s); -} - - -/* - prints - print a string using, p. -*/ - -extern "C" void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s) -{ - unsigned int l; - unsigned int i; - - l = DynamicStrings_Length (s); - i = 0; - flushSpace (p); - while (i < l) - { - if ((((i+2) <= l) && ((DynamicStrings_char (s, static_cast (i))) == '\\')) && ((DynamicStrings_char (s, static_cast (i+1))) == 'n')) - { - p->needsIndent = TRUE; - p->needsSpace = FALSE; - p->curPos = 0; - (*p->writeln.proc) (); - p->seekPos += 1; - p->curLine += 1; - i += 1; - } - else - { - flushIndent (p); - (*p->write_.proc) (DynamicStrings_char (s, static_cast (i))); - p->curPos += 1; - p->seekPos += 1; - } - i += 1; - } -} - - -/* - raw - print out string, s, without any translation of - escape sequences. -*/ - -extern "C" void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s) -{ - unsigned int l; - unsigned int i; - - l = DynamicStrings_Length (s); - i = 0; - flushSpace (p); - flushIndent (p); - while (i < l) - { - (*p->write_.proc) (DynamicStrings_char (s, static_cast (i))); - p->curPos += 1; - p->seekPos += 1; - i += 1; - } -} - -extern "C" void _M2_mcPretty_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcPretty_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcPrintf.c b/gcc/m2/mc-boot/GmcPrintf.c deleted file mode 100644 index a8660a50f4c8..000000000000 --- a/gcc/m2/mc-boot/GmcPrintf.c +++ /dev/null @@ -1,655 +0,0 @@ -/* do not edit automatically generated by mc from mcPrintf. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcPrintf_H -#define _mcPrintf_C - -# include "GSFIO.h" -# include "GFIO.h" -# include "GDynamicStrings.h" -# include "GStrLib.h" -# include "GFormatStrings.h" -# include "GnameKey.h" -# include "GM2RTS.h" - - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf0 (const char *a_, unsigned int _a_high); - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high); - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf0 (FIO_File file, const char *a_, unsigned int _a_high); - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf1 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf2 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf3 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf4 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high); - -/* - isDigit - returns TRUE if, ch, is a character 0..9 -*/ - -static unsigned int isDigit (char ch); - -/* - cast - casts a := b -*/ - -static void cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high); - -/* - TranslateNameToCharStar - takes a format specification string, a, and - if they consist of of %a then this is translated - into a String and %a is replaced by %s. -*/ - -static unsigned int TranslateNameToCharStar (char *a, unsigned int _a_high, unsigned int n); - - -/* - isDigit - returns TRUE if, ch, is a character 0..9 -*/ - -static unsigned int isDigit (char ch) -{ - return (ch >= '0') && (ch <= '9'); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - cast - casts a := b -*/ - -static void cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (b, b_, _b_high+1); - - if (_a_high == _b_high) - { - for (i=0; i<=_a_high; i++) - { - a[i] = b[i]; - } - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - TranslateNameToCharStar - takes a format specification string, a, and - if they consist of of %a then this is translated - into a String and %a is replaced by %s. -*/ - -static unsigned int TranslateNameToCharStar (char *a, unsigned int _a_high, unsigned int n) -{ - unsigned int argno; - unsigned int i; - unsigned int h; - - argno = 1; - i = 0; - h = StrLib_StrLen ((const char *) a, _a_high); - while (i < h) - { - if ((a[i] == '%') && ((i+1) < h)) - { - if ((a[i+1] == 'a') && (argno == n)) - { - a[i+1] = 's'; - return TRUE; - } - argno += 1; - if (argno > n) - { - /* all done */ - return FALSE; - } - } - i += 1; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf0 (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - mcPrintf_fprintf0 (FIO_StdOut, (const char *) a, _a_high); -} - - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - mcPrintf_fprintf1 (FIO_StdOut, (const char *) a, _a_high, (const unsigned char *) w, _w_high); -} - - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - mcPrintf_fprintf2 (FIO_StdOut, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high); -} - - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high) -{ - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - - mcPrintf_fprintf3 (FIO_StdOut, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high); -} - - -/* - printf0 - writes out an array to, StdOut, after the escape - sequences have been translated. -*/ - -extern "C" void mcPrintf_printf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high) -{ - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - unsigned char w4[_w4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - memcpy (w4, w4_, _w4_high+1); - - mcPrintf_fprintf4 (FIO_StdOut, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high); -} - - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf0 (FIO_File file, const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - if ((DynamicStrings_KillString (SFIO_WriteS (file, FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) a, _a_high))))) == NULL) - {} /* empty. */ -} - - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf1 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - DynamicStrings_String s; - DynamicStrings_String t; - nameKey_Name n; - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - if (TranslateNameToCharStar ((char *) a, _a_high, 1)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w, _w_high); - s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - t = DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)); - s = FormatStrings_Sprintf1 (t, (const unsigned char *) &s, (sizeof (s)-1)); - } - else - { - t = DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)); - s = FormatStrings_Sprintf1 (t, (const unsigned char *) w, _w_high); - } - if ((DynamicStrings_KillString (SFIO_WriteS (file, s))) == NULL) - {} /* empty. */ -} - - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf2 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - nameKey_Name n; - DynamicStrings_String s; - DynamicStrings_String s1; - DynamicStrings_String s2; - unsigned int b; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - b = (unsigned int) 0; - if (TranslateNameToCharStar ((char *) a, _a_high, 1)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high); - s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (1 )); - } - if (TranslateNameToCharStar ((char *) a, _a_high, 2)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high); - s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (2 )); - } - switch (b) - { - case (unsigned int) 0: - s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high); - break; - - case (unsigned int) ((1 << (1))): - s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high); - break; - - case (unsigned int) ((1 << (2))): - s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2))): - s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1)); - break; - - - default: - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - } - if ((DynamicStrings_KillString (SFIO_WriteS (file, s))) == NULL) - {} /* empty. */ -} - - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf3 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high) -{ - nameKey_Name n; - DynamicStrings_String s; - DynamicStrings_String s1; - DynamicStrings_String s2; - DynamicStrings_String s3; - unsigned int b; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - - b = (unsigned int) 0; - if (TranslateNameToCharStar ((char *) a, _a_high, 1)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high); - s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (1 )); - } - if (TranslateNameToCharStar ((char *) a, _a_high, 2)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high); - s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (2 )); - } - if (TranslateNameToCharStar ((char *) a, _a_high, 3)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w3, _w3_high); - s3 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (3 )); - } - switch (b) - { - case (unsigned int) 0: - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high); - break; - - case (unsigned int) ((1 << (1))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high); - break; - - case (unsigned int) ((1 << (2))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high); - break; - - case (unsigned int) ((1 << (3))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (3))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1)); - break; - - case (unsigned int) ((1 << (2)) | (1 << (3))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (3))): - s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1)); - break; - - - default: - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - } - if ((DynamicStrings_KillString (SFIO_WriteS (file, s))) == NULL) - {} /* empty. */ -} - - -/* - fprintf0 - writes out an array to, file, after the escape sequences - have been translated. -*/ - -extern "C" void mcPrintf_fprintf4 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high) -{ - nameKey_Name n; - DynamicStrings_String s; - DynamicStrings_String s1; - DynamicStrings_String s2; - DynamicStrings_String s3; - DynamicStrings_String s4; - unsigned int b; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - unsigned char w4[_w4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - memcpy (w4, w4_, _w4_high+1); - - b = (unsigned int) 0; - if (TranslateNameToCharStar ((char *) a, _a_high, 1)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high); - s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (1 )); - } - if (TranslateNameToCharStar ((char *) a, _a_high, 2)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high); - s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (2 )); - } - if (TranslateNameToCharStar ((char *) a, _a_high, 3)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w3, _w3_high); - s3 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (3 )); - } - if (TranslateNameToCharStar ((char *) a, _a_high, 4)) - { - cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w4, _w4_high); - s4 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))); - b |= (1 << (4 )); - } - switch (b) - { - case (unsigned int) 0: - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high); - break; - - case (unsigned int) ((1 << (1))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high); - break; - - case (unsigned int) ((1 << (2))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high); - break; - - case (unsigned int) ((1 << (3))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) w4, _w4_high); - break; - - case (unsigned int) ((1 << (1)) | (1 << (3))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) w4, _w4_high); - break; - - case (unsigned int) ((1 << (2)) | (1 << (3))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) w4, _w4_high); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (3))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) w4, _w4_high); - break; - - case (unsigned int) ((1 << (4))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) &s4, (sizeof (s4)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (4))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) &s4, (sizeof (s4)-1)); - break; - - case (unsigned int) ((1 << (2)) | (1 << (4))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high, (const unsigned char *) &s4, (sizeof (s4)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (4))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high, (const unsigned char *) &s4, (sizeof (s4)-1)); - break; - - case (unsigned int) ((1 << (3)) | (1 << (4))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) &s4, (sizeof (s4)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (3)) | (1 << (4))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) &s4, (sizeof (s4)-1)); - break; - - case (unsigned int) ((1 << (2)) | (1 << (3)) | (1 << (4))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) &s4, (sizeof (s4)-1)); - break; - - case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (3)) | (1 << (4))): - s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) &s4, (sizeof (s4)-1)); - break; - - - default: - M2RTS_HALT (-1); - __builtin_unreachable (); - break; - } - if ((DynamicStrings_KillString (SFIO_WriteS (file, s))) == NULL) - {} /* empty. */ -} - -extern "C" void _M2_mcPrintf_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcPrintf_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcQuiet.c b/gcc/m2/mc-boot/GmcQuiet.c deleted file mode 100644 index bcf1026001a5..000000000000 --- a/gcc/m2/mc-boot/GmcQuiet.c +++ /dev/null @@ -1,129 +0,0 @@ -/* do not edit automatically generated by mc from mcQuiet. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _mcQuiet_H -#define _mcQuiet_C - -# include "GmcOptions.h" -# include "GmcPrintf.h" - -extern "C" void mcQuiet_qprintf0 (const char *a_, unsigned int _a_high); -extern "C" void mcQuiet_qprintf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); -extern "C" void mcQuiet_qprintf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); -extern "C" void mcQuiet_qprintf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high); -extern "C" void mcQuiet_qprintf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high); - -extern "C" void mcQuiet_qprintf0 (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - if (! (mcOptions_getQuiet ())) - { - mcPrintf_printf0 ((const char *) a, _a_high); - } -} - -extern "C" void mcQuiet_qprintf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - if (! (mcOptions_getQuiet ())) - { - mcPrintf_printf1 ((const char *) a, _a_high, (const unsigned char *) w, _w_high); - } -} - -extern "C" void mcQuiet_qprintf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - if (! (mcOptions_getQuiet ())) - { - mcPrintf_printf2 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high); - } -} - -extern "C" void mcQuiet_qprintf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high) -{ - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - - if (! (mcOptions_getQuiet ())) - { - mcPrintf_printf3 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high); - } -} - -extern "C" void mcQuiet_qprintf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high) -{ - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - unsigned char w3[_w3_high+1]; - unsigned char w4[_w4_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - memcpy (w3, w3_, _w3_high+1); - memcpy (w4, w4_, _w4_high+1); - - if (! (mcOptions_getQuiet ())) - { - mcPrintf_printf4 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high); - } -} - -extern "C" void _M2_mcQuiet_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcQuiet_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcReserved.c b/gcc/m2/mc-boot/GmcReserved.c deleted file mode 100644 index 60b879630bbc..000000000000 --- a/gcc/m2/mc-boot/GmcReserved.c +++ /dev/null @@ -1,40 +0,0 @@ -/* do not edit automatically generated by mc from mcReserved. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _mcReserved_H -#define _mcReserved_C - - -typedef enum {mcReserved_eoftok, mcReserved_plustok, mcReserved_minustok, mcReserved_timestok, mcReserved_dividetok, mcReserved_becomestok, mcReserved_ambersandtok, mcReserved_periodtok, mcReserved_commatok, mcReserved_semicolontok, mcReserved_lparatok, mcReserved_rparatok, mcReserved_lsbratok, mcReserved_rsbratok, mcReserved_lcbratok, mcReserved_rcbratok, mcReserved_uparrowtok, mcReserved_singlequotetok, mcReserved_equaltok, mcReserved_hashtok, mcReserved_lesstok, mcReserved_greatertok, mcReserved_lessgreatertok, mcReserved_lessequaltok, mcReserved_greaterequaltok, mcReserved_ldirectivetok, mcReserved_rdirectivetok, mcReserved_periodperiodtok, mcReserved_colontok, mcReserved_doublequotestok, mcReserved_bartok, mcReserved_andtok, mcReserved_arraytok, mcReserved_begintok, mcReserved_bytok, mcReserved_casetok, mcReserved_consttok, mcReserved_definitiontok, mcReserved_divtok, mcReserved_dotok, mcReserved_elsetok, mcReserved_elsiftok, mcReserved_endtok, mcReserved_excepttok, mcReserved_exittok, mcReserved_exporttok, mcReserved_finallytok, mcReserved_fortok, mcReserved_fromtok, mcReserved_iftok, mcReserved_implementationtok, mcReserved_importtok, mcReserved_intok, mcReserved_looptok, mcReserved_modtok, mcReserved_moduletok, mcReserved_nottok, mcReserved_oftok, mcReserved_ortok, mcReserved_packedsettok, mcReserved_pointertok, mcReserved_proceduretok, mcReserved_qualifiedtok, mcReserved_unqualifiedtok, mcReserved_recordtok, mcReserved_remtok, mcReserved_repeattok, mcReserved_retrytok, mcReserved_returntok, mcReserved_settok, mcReserved_thentok, mcReserved_totok, mcReserved_typetok, mcReserved_untiltok, mcReserved_vartok, mcReserved_whiletok, mcReserved_withtok, mcReserved_asmtok, mcReserved_volatiletok, mcReserved_periodperiodperiodtok, mcReserved_datetok, mcReserved_linetok, mcReserved_filetok, mcReserved_attributetok, mcReserved_builtintok, mcReserved_inlinetok, mcReserved_integertok, mcReserved_identtok, mcReserved_realtok, mcReserved_stringtok, mcReserved_commenttok} mcReserved_toktype; - - -extern "C" void _M2_mcReserved_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcReserved_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcSearch.c b/gcc/m2/mc-boot/GmcSearch.c deleted file mode 100644 index a4541fa0d370..000000000000 --- a/gcc/m2/mc-boot/GmcSearch.c +++ /dev/null @@ -1,408 +0,0 @@ -/* do not edit automatically generated by mc from mcSearch. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcSearch_H -#define _mcSearch_C - -# include "GSFIO.h" -# include "GmcFileName.h" -# include "GDynamicStrings.h" - -# define Directory '/' -static DynamicStrings_String Def; -static DynamicStrings_String Mod; -static DynamicStrings_String UserPath; -static DynamicStrings_String InitialPath; - -/* - initSearchPath - assigns the search path to Path. - The string Path may take the form: - - Path ::= IndividualPath { ":" IndividualPath } - IndividualPath ::= "." | DirectoryPath - DirectoryPath ::= [ "/" ] Name { "/" Name } - Name ::= Letter { (Letter | Number) } - Letter ::= A..Z | a..z - Number ::= 0..9 -*/ - -extern "C" void mcSearch_initSearchPath (DynamicStrings_String path); - -/* - prependSearchPath - prepends a new path to the initial search path. -*/ - -extern "C" void mcSearch_prependSearchPath (DynamicStrings_String path); - -/* - findSourceFile - attempts to locate the source file FileName. - If a file is found then TRUE is returned otherwise - FALSE is returned. - The parameter fullPath is set indicating the - absolute location of source FileName. - fullPath will be totally overwritten and should - not be initialized by InitString before this function - is called. - fullPath is set to NIL if this function returns FALSE. - findSourceFile sets fullPath to a new string if successful. - The string, FileName, is not altered. -*/ - -extern "C" unsigned int mcSearch_findSourceFile (DynamicStrings_String FileName, DynamicStrings_String *fullPath); - -/* - findSourceDefFile - attempts to find the definition module for - a module, stem. If successful it returns - the full path and returns TRUE. If unsuccessful - then FALSE is returned and fullPath is set to NIL. -*/ - -extern "C" unsigned int mcSearch_findSourceDefFile (DynamicStrings_String stem, DynamicStrings_String *fullPath); - -/* - findSourceModFile - attempts to find the implementation module for - a module, stem. If successful it returns - the full path and returns TRUE. If unsuccessful - then FALSE is returned and fullPath is set to NIL. -*/ - -extern "C" unsigned int mcSearch_findSourceModFile (DynamicStrings_String stem, DynamicStrings_String *fullPath); - -/* - setDefExtension - sets the default extension for definition modules to, ext. - The string, ext, should be deallocated by the caller at - an appropriate time. -*/ - -extern "C" void mcSearch_setDefExtension (DynamicStrings_String ext); - -/* - setModExtension - sets the default extension for implementation and program - modules to, ext. The string, ext, should be deallocated - by the caller at an appropriate time. -*/ - -extern "C" void mcSearch_setModExtension (DynamicStrings_String ext); - -/* - doDSdbEnter - -*/ - -static void doDSdbEnter (void); - -/* - doDSdbExit - -*/ - -static void doDSdbExit (DynamicStrings_String s); - -/* - DSdbEnter - -*/ - -static void DSdbEnter (void); - -/* - DSdbExit - -*/ - -static void DSdbExit (DynamicStrings_String s); - -/* - Init - initializes the search path. -*/ - -static void Init (void); - - -/* - doDSdbEnter - -*/ - -static void doDSdbEnter (void) -{ - DynamicStrings_PushAllocation (); -} - - -/* - doDSdbExit - -*/ - -static void doDSdbExit (DynamicStrings_String s) -{ - s = DynamicStrings_PopAllocationExemption (TRUE, s); -} - - -/* - DSdbEnter - -*/ - -static void DSdbEnter (void) -{ -} - - -/* - DSdbExit - -*/ - -static void DSdbExit (DynamicStrings_String s) -{ -} - - -/* - Init - initializes the search path. -*/ - -static void Init (void) -{ - UserPath = DynamicStrings_InitString ((const char *) "", 0); - InitialPath = DynamicStrings_InitStringChar ('.'); - Def = static_cast (NULL); - Mod = static_cast (NULL); -} - - -/* - initSearchPath - assigns the search path to Path. - The string Path may take the form: - - Path ::= IndividualPath { ":" IndividualPath } - IndividualPath ::= "." | DirectoryPath - DirectoryPath ::= [ "/" ] Name { "/" Name } - Name ::= Letter { (Letter | Number) } - Letter ::= A..Z | a..z - Number ::= 0..9 -*/ - -extern "C" void mcSearch_initSearchPath (DynamicStrings_String path) -{ - if (InitialPath != NULL) - { - InitialPath = DynamicStrings_KillString (InitialPath); - } - InitialPath = path; -} - - -/* - prependSearchPath - prepends a new path to the initial search path. -*/ - -extern "C" void mcSearch_prependSearchPath (DynamicStrings_String path) -{ - DSdbEnter (); - if (DynamicStrings_EqualArray (UserPath, (const char *) "", 0)) - { - UserPath = DynamicStrings_KillString (UserPath); - UserPath = DynamicStrings_Dup (path); - } - else - { - UserPath = DynamicStrings_ConCat (DynamicStrings_ConCatChar (UserPath, ':'), path); - } - DSdbExit (UserPath); -} - - -/* - findSourceFile - attempts to locate the source file FileName. - If a file is found then TRUE is returned otherwise - FALSE is returned. - The parameter fullPath is set indicating the - absolute location of source FileName. - fullPath will be totally overwritten and should - not be initialized by InitString before this function - is called. - fullPath is set to NIL if this function returns FALSE. - findSourceFile sets fullPath to a new string if successful. - The string, FileName, is not altered. -*/ - -extern "C" unsigned int mcSearch_findSourceFile (DynamicStrings_String FileName, DynamicStrings_String *fullPath) -{ - DynamicStrings_String completeSearchPath; - int start; - int end; - DynamicStrings_String newpath; - - if (DynamicStrings_EqualArray (UserPath, (const char *) "", 0)) - { - if (DynamicStrings_EqualArray (InitialPath, (const char *) "", 0)) - { - completeSearchPath = DynamicStrings_InitString ((const char *) ".", 1); - } - else - { - completeSearchPath = DynamicStrings_Dup (InitialPath); - } - } - else - { - completeSearchPath = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Dup (UserPath), ':'), InitialPath); - } - start = 0; - end = DynamicStrings_Index (completeSearchPath, ':', (unsigned int ) (start)); - do { - if (end == -1) - { - end = 0; - } - newpath = DynamicStrings_Slice (completeSearchPath, start, end); - if (DynamicStrings_EqualArray (newpath, (const char *) ".", 1)) - { - newpath = DynamicStrings_KillString (newpath); - newpath = DynamicStrings_Dup (FileName); - } - else - { - newpath = DynamicStrings_ConCat (DynamicStrings_ConCatChar (newpath, Directory), FileName); - } - if (SFIO_Exists (newpath)) - { - (*fullPath) = newpath; - completeSearchPath = DynamicStrings_KillString (completeSearchPath); - return TRUE; - } - newpath = DynamicStrings_KillString (newpath); - if (end != 0) - { - start = end+1; - end = DynamicStrings_Index (completeSearchPath, ':', (unsigned int ) (start)); - } - } while (! (end == 0)); - (*fullPath) = static_cast (NULL); - newpath = DynamicStrings_KillString (newpath); - completeSearchPath = DynamicStrings_KillString (completeSearchPath); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - findSourceDefFile - attempts to find the definition module for - a module, stem. If successful it returns - the full path and returns TRUE. If unsuccessful - then FALSE is returned and fullPath is set to NIL. -*/ - -extern "C" unsigned int mcSearch_findSourceDefFile (DynamicStrings_String stem, DynamicStrings_String *fullPath) -{ - DynamicStrings_String f; - - if (Def != NULL) - { - f = mcFileName_calculateFileName (stem, Def); - if (mcSearch_findSourceFile (f, fullPath)) - { - return TRUE; - } - f = DynamicStrings_KillString (f); - } - /* and try the GNU Modula-2 default extension */ - f = mcFileName_calculateFileName (stem, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "def", 3))); - return mcSearch_findSourceFile (f, fullPath); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - findSourceModFile - attempts to find the implementation module for - a module, stem. If successful it returns - the full path and returns TRUE. If unsuccessful - then FALSE is returned and fullPath is set to NIL. -*/ - -extern "C" unsigned int mcSearch_findSourceModFile (DynamicStrings_String stem, DynamicStrings_String *fullPath) -{ - DynamicStrings_String f; - - if (Mod != NULL) - { - f = mcFileName_calculateFileName (stem, Mod); - if (mcSearch_findSourceFile (f, fullPath)) - { - return TRUE; - } - f = DynamicStrings_KillString (f); - } - /* and try the GNU Modula-2 default extension */ - f = mcFileName_calculateFileName (stem, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "mod", 3))); - return mcSearch_findSourceFile (f, fullPath); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setDefExtension - sets the default extension for definition modules to, ext. - The string, ext, should be deallocated by the caller at - an appropriate time. -*/ - -extern "C" void mcSearch_setDefExtension (DynamicStrings_String ext) -{ - Def = DynamicStrings_KillString (Def); - Def = DynamicStrings_Dup (ext); -} - - -/* - setModExtension - sets the default extension for implementation and program - modules to, ext. The string, ext, should be deallocated - by the caller at an appropriate time. -*/ - -extern "C" void mcSearch_setModExtension (DynamicStrings_String ext) -{ - Mod = DynamicStrings_KillString (Mod); - Mod = DynamicStrings_Dup (ext); -} - -extern "C" void _M2_mcSearch_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_mcSearch_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcStack.c b/gcc/m2/mc-boot/GmcStack.c deleted file mode 100644 index 95d31a5037b1..000000000000 --- a/gcc/m2/mc-boot/GmcStack.c +++ /dev/null @@ -1,228 +0,0 @@ -/* do not edit automatically generated by mc from mcStack. */ -/* This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT 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 along -with gm2; see the file COPYING. If not, write to the Free Software -Foundation, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcStack_H -#define _mcStack_C - -# include "GStorage.h" -# include "GIndexing.h" -# include "GM2RTS.h" - -typedef struct mcStack__T1_r mcStack__T1; - -typedef mcStack__T1 *mcStack_stack; - -struct mcStack__T1_r { - Indexing_Index list; - unsigned int count; - }; - - -/* - init - create and return a stack. -*/ - -extern "C" mcStack_stack mcStack_init (void); - -/* - kill - deletes stack, s. -*/ - -extern "C" void mcStack_kill (mcStack_stack *s); - -/* - push - an address, a, onto the stack, s. - It returns, a. -*/ - -extern "C" void * mcStack_push (mcStack_stack s, void * a); - -/* - pop - and return the top element from stack, s. -*/ - -extern "C" void * mcStack_pop (mcStack_stack s); - -/* - replace - performs a pop; push (a); return a. -*/ - -extern "C" void * mcStack_replace (mcStack_stack s, void * a); - -/* - depth - returns the depth of the stack. -*/ - -extern "C" unsigned int mcStack_depth (mcStack_stack s); - -/* - access - returns the, i, th stack element. - The top of stack is defined by: - - access (s, depth (s)). -*/ - -extern "C" void * mcStack_access (mcStack_stack s, unsigned int i); - - -/* - init - create and return a stack. -*/ - -extern "C" mcStack_stack mcStack_init (void) -{ - mcStack_stack s; - - Storage_ALLOCATE ((void **) &s, sizeof (mcStack__T1)); - s->list = Indexing_InitIndex (1); - s->count = 0; - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - kill - deletes stack, s. -*/ - -extern "C" void mcStack_kill (mcStack_stack *s) -{ - (*s)->list = Indexing_KillIndex ((*s)->list); - Storage_DEALLOCATE ((void **) &(*s), sizeof (mcStack__T1)); - (*s) = NULL; -} - - -/* - push - an address, a, onto the stack, s. - It returns, a. -*/ - -extern "C" void * mcStack_push (mcStack_stack s, void * a) -{ - if (s->count == 0) - { - Indexing_PutIndice (s->list, Indexing_LowIndice (s->list), a); - } - else - { - Indexing_PutIndice (s->list, (Indexing_HighIndice (s->list))+1, a); - } - s->count += 1; - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - pop - and return the top element from stack, s. -*/ - -extern "C" void * mcStack_pop (mcStack_stack s) -{ - void * a; - - if (s->count == 0) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - s->count -= 1; - a = Indexing_GetIndice (s->list, Indexing_HighIndice (s->list)); - Indexing_DeleteIndice (s->list, Indexing_HighIndice (s->list)); - return a; - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/mcStack.def", 20, 1); - __builtin_unreachable (); -} - - -/* - replace - performs a pop; push (a); return a. -*/ - -extern "C" void * mcStack_replace (mcStack_stack s, void * a) -{ - void * b; - - b = mcStack_pop (s); - return mcStack_push (s, a); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - depth - returns the depth of the stack. -*/ - -extern "C" unsigned int mcStack_depth (mcStack_stack s) -{ - return s->count; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - access - returns the, i, th stack element. - The top of stack is defined by: - - access (s, depth (s)). -*/ - -extern "C" void * mcStack_access (mcStack_stack s, unsigned int i) -{ - if ((i > s->count) || (i == 0)) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return Indexing_GetIndice (s->list, i); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/mcStack.def", 20, 1); - __builtin_unreachable (); -} - -extern "C" void _M2_mcStack_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcStack_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GmcStream.c b/gcc/m2/mc-boot/GmcStream.c deleted file mode 100644 index e4ce0528cf5c..000000000000 --- a/gcc/m2/mc-boot/GmcStream.c +++ /dev/null @@ -1,266 +0,0 @@ -/* do not edit automatically generated by mc from mcStream. */ -/* mcStream.mod provides an interface to create a file from fragments. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcStream_H -#define _mcStream_C - -# include "GFIO.h" -# include "Glibc.h" -# include "GIndexing.h" -# include "GDynamicStrings.h" -# include "GFormatStrings.h" -# include "GSYSTEM.h" -# include "GStorage.h" -# include "Galists.h" -# include "GSFIO.h" -# include "GM2RTS.h" - -typedef FIO_File *mcStream_ptrToFile; - -# define maxBuffer 4096 -static alists_alist listOfFiles; -static Indexing_Index frag; -static FIO_File destFile; -static unsigned int seenDest; - -/* - openFrag - create and open fragment, id, and return the file. - The file should not be closed by the user. -*/ - -extern "C" FIO_File mcStream_openFrag (unsigned int id); - -/* - setDest - informs the stream module and all fragments must be copied - info, f. -*/ - -extern "C" void mcStream_setDest (FIO_File f); - -/* - combine - closes all fragments and then writes them in - order to the destination file. The dest file - is returned. -*/ - -extern "C" FIO_File mcStream_combine (void); - -/* - removeFiles - remove any fragment. -*/ - -extern "C" void mcStream_removeFiles (void); - -/* - removeLater - -*/ - -static DynamicStrings_String removeLater (DynamicStrings_String filename); - -/* - removeNow - removes a single file, s. -*/ - -static void removeNow (DynamicStrings_String s); - -/* - createTemporaryFile - -*/ - -static FIO_File createTemporaryFile (unsigned int id); - -/* - copy - copies contents of f to the destination file. -*/ - -static void copy (mcStream_ptrToFile p); - - -/* - removeLater - -*/ - -static DynamicStrings_String removeLater (DynamicStrings_String filename) -{ - alists_includeItemIntoList (listOfFiles, reinterpret_cast (filename)); - return filename; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - removeNow - removes a single file, s. -*/ - -static void removeNow (DynamicStrings_String s) -{ - if ((libc_unlink (DynamicStrings_string (s))) != 0) - {} /* empty. */ -} - - -/* - createTemporaryFile - -*/ - -static FIO_File createTemporaryFile (unsigned int id) -{ - DynamicStrings_String s; - FIO_File f; - int p; - - s = DynamicStrings_InitString ((const char *) "/tmp/frag-%d-%d.frag", 20); - p = libc_getpid (); - s = removeLater (FormatStrings_Sprintf2 (s, (const unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) &id, (sizeof (id)-1))); - f = SFIO_OpenToWrite (s); - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - copy - copies contents of f to the destination file. -*/ - -static void copy (mcStream_ptrToFile p) -{ - typedef struct copy__T1_a copy__T1; - - struct copy__T1_a { char array[maxBuffer+1]; }; - copy__T1 buffer; - unsigned int b; - DynamicStrings_String s; - FIO_File f; - - if (p != NULL) - { - f = (*p); - s = DynamicStrings_InitStringCharStar (FIO_getFileName (f)); - FIO_Close (f); - f = SFIO_OpenToRead (s); - while (! (FIO_EOF (f))) - { - b = FIO_ReadNBytes (f, maxBuffer, &buffer); - b = FIO_WriteNBytes (destFile, b, &buffer); - } - FIO_Close (f); - } -} - - -/* - openFrag - create and open fragment, id, and return the file. - The file should not be closed by the user. -*/ - -extern "C" FIO_File mcStream_openFrag (unsigned int id) -{ - FIO_File f; - mcStream_ptrToFile p; - - f = createTemporaryFile (id); - Storage_ALLOCATE ((void **) &p, sizeof (FIO_File)); - (*p) = f; - Indexing_PutIndice (frag, id, reinterpret_cast (p)); - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - setDest - informs the stream module and all fragments must be copied - info, f. -*/ - -extern "C" void mcStream_setDest (FIO_File f) -{ - seenDest = TRUE; - destFile = f; -} - - -/* - combine - closes all fragments and then writes them in - order to the destination file. The dest file - is returned. -*/ - -extern "C" FIO_File mcStream_combine (void) -{ - if (! seenDest) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - Indexing_ForeachIndiceInIndexDo (frag, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) copy}); - mcStream_removeFiles (); - return destFile; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - removeFiles - remove any fragment. -*/ - -extern "C" void mcStream_removeFiles (void) -{ - alists_foreachItemInListDo (listOfFiles, (alists_performOperation) {(alists_performOperation_t) removeNow}); - alists_killList (&listOfFiles); - listOfFiles = alists_initList (); -} - -extern "C" void _M2_mcStream_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - listOfFiles = alists_initList (); - seenDest = FALSE; - frag = Indexing_InitIndex (1); -} - -extern "C" void _M2_mcStream_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gmcp1.c b/gcc/m2/mc-boot/Gmcp1.c deleted file mode 100644 index 97bedb257140..000000000000 --- a/gcc/m2/mc-boot/Gmcp1.c +++ /dev/null @@ -1,7265 +0,0 @@ -/* do not edit automatically generated by mc from mcp1. */ -/* output from mc-1.bnf, automatically generated do not edit. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING. If not, -see . */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcp1_H -#define _mcp1_C - -# include "GDynamicStrings.h" -# include "GmcError.h" -# include "GnameKey.h" -# include "GmcPrintf.h" -# include "GmcDebug.h" -# include "GmcReserved.h" -# include "GmcComment.h" -# include "GmcLexBuf.h" -# include "Gdecl.h" - -# define Pass1 TRUE -# define Debugging FALSE -typedef unsigned int mcp1_stop0; - -typedef unsigned int mcp1_SetOfStop0; - -typedef unsigned int mcp1_stop1; - -typedef unsigned int mcp1_SetOfStop1; - -typedef unsigned int mcp1_stop2; - -typedef unsigned int mcp1_SetOfStop2; - -static unsigned int WasNoError; -static nameKey_Name curident; -static decl_node curproc; -static decl_node curmodule; - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp1_CompilationUnit (void); -static void ErrorString (DynamicStrings_String s); -static void ErrorArray (const char *a_, unsigned int _a_high); - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high); - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void); - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t); - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t); - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - string - -*/ - -static void string (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Integer - -*/ - -static void Integer (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Real - -*/ - -static void Real (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - registerImport - looks up module, ident, and adds it to the - current module import list. -*/ - -static void registerImport (nameKey_Name ident, unsigned int scoped); - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % enterScope (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % leaveScope % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % leaveScope ; leaveScope % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SimpleConstExpr := UnaryOrConstTerm { AddOperator - ConstTerm } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - UnaryOrConstTerm := '+' ConstTerm | - '-' ConstTerm | - ConstTerm - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstTerm := ConstFactor { MulOperator ConstFactor } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstFactor := Number | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpression ')' | - 'NOT' ConstFactor | - ConstAttribute - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ComponentElement := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ComponentValue := ComponentElement [ 'BY' ConstExpression ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Constructor := '{' [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstSetOrQualidentOrFunction := Qualident [ Constructor | - ConstActualParameters ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstActualParameters := ActualParameters - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstAttributeExpression := Ident | '<' Qualident - ',' Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AlignmentExpression := '(' ConstExpression ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - TypeDeclaration := Ident - % VAR n: node ; % - - % n := makeTypeImp (curident) % - '=' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void TypeDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Type := ( SimpleType | ArrayType | RecordType | - SetType | PointerType | - ProcedureType ) - - first symbols:lparatok, lsbratok, proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok - - cannot reachend -*/ - -static void Type (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SimpleType := Qualident [ SubrangeType ] | - Enumeration | SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Enumeration := '(' ( IdentList ) ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SubrangeType := '[' ConstExpression '..' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ArrayType := 'ARRAY' SimpleType { ',' SimpleType } - 'OF' Type - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - RecordType := 'RECORD' [ DefaultRecordAttributes ] - FieldListSequence 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - PragmaConstExpression := [ '(' ConstExpression ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AttributeExpression := Ident '(' ConstExpression - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FieldList := IdentList ':' Type RecordFieldPragma | - 'CASE' CaseTag 'OF' Varient { '|' Varient } - [ 'ELSE' FieldListSequence ] 'END' - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - TagIdent := [ Ident ] - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - CaseTag := TagIdent [ ':' Qualident ] - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Varient := [ VarientCaseLabelList ':' FieldListSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - VarientCaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentConstExpression := SilentSimpleConstExpr [ - SilentRelation SilentSimpleConstExpr ] - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentRelation := '=' | '#' | '<>' | '<' | - '<=' | '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void SilentRelation (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentSimpleConstExpr := SilentUnaryOrConstTerm - { SilentAddOperator SilentConstTerm } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentSimpleConstExpr (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentUnaryOrConstTerm := '+' SilentConstTerm | - '-' SilentConstTerm | - SilentConstTerm - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentUnaryOrConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentAddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void SilentAddOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentConstTerm := SilentConstFactor { SilentMulOperator - SilentConstFactor } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void SilentConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentMulOperator := '*' | '/' | 'DIV' | - 'MOD' | 'REM' | 'AND' | - '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void SilentMulOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentConstFactor := Number | SilentConstString | - SilentConstSetOrQualidentOrFunction | - '(' SilentConstExpression ')' | - 'NOT' SilentConstFactor | - SilentConstAttribute - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void SilentConstFactor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void SilentConstString (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' SilentConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void SilentConstAttribute (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentConstAttributeExpression := Ident | - '<' Ident ',' - SilentConstString - '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void SilentConstAttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentComponentElement := SilentConstExpression - [ '..' SilentConstExpression ] - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentComponentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentComponentValue := SilentComponentElement [ - 'BY' SilentConstExpression ] - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentComponentValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentArraySetRecordValue := SilentComponentValue - { ',' SilentComponentValue } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentArraySetRecordValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentConstructor := '{' [ SilentArraySetRecordValue ] - '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void SilentConstructor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentConstSetOrQualidentOrFunction := SilentConstructor | - Qualident - [ SilentConstructor | - SilentActualParameters ] - - first symbols:identtok, lcbratok - - cannot reachend -*/ - -static void SilentConstSetOrQualidentOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentElement := SilentConstExpression [ '..' SilentConstExpression ] - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentActualParameters := '(' [ SilentExpList ] - ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void SilentActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SilentExpList := SilentConstExpression { ',' SilentConstExpression } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - PointerType := 'POINTER' 'TO' Type - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProcedureType := 'PROCEDURE' [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - OptReturnType := '[' Qualident ']' | - Qualident - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProcedureParameters := ProcedureParameter { ',' - ProcedureParameter } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProcedureParameter := '...' | 'VAR' FormalType | - FormalType - - first symbols:arraytok, identtok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - VarIdent := Ident - % VAR n: node ; % - - % n := makeVar (curident) % - [ '[' ConstExpression ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - VarIdentList := VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - VariableDeclaration := VarIdentList ':' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Designator := Qualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SubDesignator := '.' Ident | '[' ArrayExpList ']' | - '^' - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ArrayExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Expression := SimpleExpression [ Relation SimpleExpression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SimpleExpression := UnaryOrTerm { AddOperator Term } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - UnaryOrTerm := '+' Term | '-' Term | - Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Term := Factor { MulOperator Factor } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Factor := Number | string | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor | ConstAttribute ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SetOrDesignatorOrFunction := Qualident [ Constructor | - SimpleDes - [ ActualParameters ] ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - SimpleDes := { SubDesignator } - - first symbols:periodtok, lsbratok, uparrowtok - - reachend -*/ - -static void SimpleDes (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ActualParameters := '(' [ ExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ExitStatement := 'EXIT' - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ReturnStatement := 'RETURN' [ Expression ] - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Statement := [ AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement ] - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok - - reachend -*/ - -static void Statement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - RetryStatement := 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AssignmentOrProcedureCall := Designator ( ':=' Expression | - ActualParameters | - - % epsilon % - ) - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - StatementSequence := Statement { ';' Statement } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - IfStatement := 'IF' Expression 'THEN' StatementSequence - { 'ELSIF' Expression 'THEN' StatementSequence } - [ 'ELSE' StatementSequence ] 'END' - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - CaseStatement := 'CASE' Expression 'OF' Case { '|' - Case } - CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - CaseEndStatement := 'END' | 'ELSE' StatementSequence - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Case := [ CaseLabelList ':' StatementSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - CaseLabelList := CaseLabels { ',' CaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - CaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - WhileStatement := 'WHILE' Expression 'DO' StatementSequence - 'END' - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - RepeatStatement := 'REPEAT' StatementSequence 'UNTIL' - Expression - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ForStatement := 'FOR' Ident ':=' Expression 'TO' - Expression [ 'BY' ConstExpression ] - 'DO' StatementSequence 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - LoopStatement := 'LOOP' StatementSequence 'END' - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - WithStatement := 'WITH' Designator 'DO' StatementSequence - 'END' - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefProcedureIdent := Ident - % curproc := makeProcedure (curident) ; - setProcedureComment (lastcomment, curident) ; - putCommentDefProcedure (curproc) ; - % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefProcedureIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) ; - IF curproc=NIL - THEN - curproc := makeProcedure (curident) - END ; - setProcedureComment (lastcomment, curident) ; - putCommentModProcedure (curproc) ; - % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent - % enterScope (curproc) % - [ FormalParameters ] AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - % leaveScope % - - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - NormalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ExceptionalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration ';' } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefFormalParameters := '(' [ DefMultiFPSection ] - ')' FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FormalParameters := '(' [ MultiFPSection ] ')' - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AttributeNoReturn := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AttributeUnused := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefExtendedFP := DefOptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - VarFPSection := 'VAR' IdentList ':' FormalType [ - AttributeUnused ] - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ] - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ] - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefOptArg := '[' Ident ':' FormalType '=' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FormalType := { 'ARRAY' 'OF' } Qualident - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Priority := '[' ConstExpression ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - FromImport := 'FROM' Ident - % registerImport (curident, FALSE) % - 'IMPORT' IdentList ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ImportModuleList := Ident - % registerImport (curident, TRUE) % - { ',' Ident - % registerImport (curident, TRUE) % - } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefinitionModule := - % VAR c: BOOLEAN ; % - - % c := FALSE % - 'DEFINITION' 'MODULE' [ 'FOR' - string - - % c := TRUE % - ] Ident - ';' - % curmodule := lookupDef (curident) % - - % IF c THEN putDefForC (curmodule) END % - - % enterScope (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % leaveScope % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - DefTypeDeclaration := { Ident - % VAR n: node ; % - - % n := makeType (curident) % - ( ';' - % putTypeHidden (n) % - | '=' Type Alignment - ';' ) } - - first symbols:identtok - - reachend -*/ - -static void DefTypeDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - ConstantDeclaration := Ident - % VAR n: node ; % - - % n := makeConst (curident) % - '=' ConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - Definition := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { DefTypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2); - -static void ErrorString (DynamicStrings_String s) -{ - mcError_errorStringAt (s, mcLexBuf_getTokenNo ()); - WasNoError = FALSE; -} - -static void ErrorArray (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - ErrorString (DynamicStrings_InitString ((const char *) a, _a_high)); -} - - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high) -{ - DynamicStrings_String s; - char desc[_desc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (desc, desc_, _desc_high+1); - - if ((decl_getSymName (module)) != name) - { - s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41); - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high))); - ErrorString (s); - } -} - - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - unsigned int n; - DynamicStrings_String str; - DynamicStrings_String message; - - n = 0; - message = DynamicStrings_InitString ((const char *) "", 0); - if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6))); - n += 1; - } - if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11))); - n += 1; - } - if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10))); - n += 1; - } - if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14))); - n += 1; - } - if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10))); - n += 1; - } - if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11))); - n += 1; - } - if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13))); - n += 1; - } - if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3))); - n += 1; - } - if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8))); - n += 1; - } - if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3))); - n += 1; - } - if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4))); - n += 1; - } - if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5))); - n += 1; - } - if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3))); - n += 1; - } - if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5))); - n += 1; - } - if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4))); - n += 1; - } - if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2))); - n += 1; - } - if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4))); - n += 1; - } - if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3))); - n += 1; - } - if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6))); - n += 1; - } - if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5))); - n += 1; - } - if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6))); - n += 1; - } - if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3))); - n += 1; - } - if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6))); - n += 1; - } - if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11))); - n += 1; - } - if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9))); - n += 1; - } - if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9))); - n += 1; - } - if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7))); - n += 1; - } - if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9))); - n += 1; - } - if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2))); - n += 1; - } - if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2))); - n += 1; - } - if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3))); - n += 1; - } - if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6))); - n += 1; - } - if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3))); - n += 1; - } - if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4))); - n += 1; - } - if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2))); - n += 1; - } - if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14))); - n += 1; - } - if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2))); - n += 1; - } - if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4))); - n += 1; - } - if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3))); - n += 1; - } - if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7))); - n += 1; - } - if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4))); - n += 1; - } - if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6))); - n += 1; - } - if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3))); - n += 1; - } - if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5))); - n += 1; - } - if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4))); - n += 1; - } - if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2))); - n += 1; - } - if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3))); - n += 1; - } - if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10))); - n += 1; - } - if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5))); - n += 1; - } - if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4))); - n += 1; - } - if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2))); - n += 1; - } - if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5))); - n += 1; - } - if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5))); - n += 1; - } - if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3))); - n += 1; - } - if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2))); - n += 1; - } - if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2))); - n += 1; - } - if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2))); - n += 1; - } - if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2))); - n += 1; - } - if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1))); - n += 1; - } - if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1))); - n += 1; - } - if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1))); - n += 1; - } - if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1))); - n += 1; - } - if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))); - n += 1; - } - if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1))); - n += 1; - } - if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1))); - n += 1; - } - if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1))); - n += 1; - } - if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1))); - n += 1; - } - if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1))); - n += 1; - } - if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ','); - n += 1; - } - if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ','); - n += 1; - } - if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1))); - n += 1; - } - if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1))); - n += 1; - } - if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1))); - n += 1; - } - if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1))); - n += 1; - } - if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1))); - n += 1; - } - if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1))); - n += 1; - } - if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1))); - n += 1; - } - if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1))); - n += 1; - } - if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1))); - n += 1; - } - if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2))); - n += 1; - } - if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0)) - {} /* empty. */ - /* eoftok has no token name (needed to generate error messages) */ - if (n == 0) - { - str = DynamicStrings_InitString ((const char *) " syntax error", 13); - message = DynamicStrings_KillString (message); - } - else if (n == 1) - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9))); - } - else - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message); - message = DynamicStrings_KillString (message); - } - return str; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void) -{ - DynamicStrings_String str; - - str = DynamicStrings_InitString ((const char *) "", 0); - switch (mcLexBuf_currenttoken) - { - case mcReserved_stringtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_realtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_identtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_integertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_inlinetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_builtintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_attributetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str)); - break; - - case mcReserved_filetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_linetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_datetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_volatiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_asmtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_withtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_whiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_vartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_untiltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_typetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_totok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_thentok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_settok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_returntok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_retrytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_repeattok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_remtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_recordtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_unqualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_qualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_proceduretok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_pointertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_packedsettok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_ortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_oftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_nottok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_moduletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_modtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_looptok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_intok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_importtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_implementationtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_iftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_fromtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_fortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_finallytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_exporttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_exittok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_excepttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_endtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsiftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_dotok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_divtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_definitiontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_consttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_casetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_bytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_begintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_arraytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_andtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_colontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_rdirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_ldirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_greaterequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessgreatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_hashtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_equaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_uparrowtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_semicolontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_commatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_ambersandtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_dividetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_timestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_minustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_plustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_doublequotestok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str)); - break; - - case mcReserved_singlequotetok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str)); - break; - - case mcReserved_greatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lesstok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_bartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_becomestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_eoftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str)); - break; - - - default: - break; - } - ErrorString (str); -} - - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - DescribeError (); - if (Debugging) - { - mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21); - } - /* - yes the ORD(currenttoken) looks ugly, but it is *much* safer than - using currenttoken= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - mcLexBuf_getToken (); - } - if (Debugging) - { - mcPrintf_printf0 ((const char *) " ***\\n", 6); - } -} - - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - SyntaxError (stopset0, stopset1, stopset2); - } -} - - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t) -{ - mcp1_SetOfStop0 s0; - mcp1_SetOfStop1 s1; - mcp1_SetOfStop2 s2; - DynamicStrings_String str; - - s0 = (mcp1_SetOfStop0) 0; - s1 = (mcp1_SetOfStop1) 0; - s2 = (mcp1_SetOfStop2) 0; - if ( ((unsigned int) (t)) < 32) - { - s0 = (mcp1_SetOfStop0) ((1 << (t-mcReserved_eoftok))); - } - else if ( ((unsigned int) (t)) < 64) - { - /* avoid dangling else. */ - s1 = (mcp1_SetOfStop1) ((1 << (t-mcReserved_arraytok))); - } - else - { - /* avoid dangling else. */ - s2 = (mcp1_SetOfStop2) ((1 << (t-mcReserved_recordtok))); - } - str = DescribeStop (s0, s1, s2); - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str)); - mcError_errorStringAt (str, mcLexBuf_getTokenNo ()); -} - - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t) -{ - WarnMissingToken (t); - if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok)) - { - if (Debugging) - { - mcPrintf_printf0 ((const char *) "inserting token\\n", 17); - } - mcLexBuf_insertToken (t); - } -} - - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - WarnMissingToken (t); - mcLexBuf_insertTokenAndRewind (t); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2)))) - { - /* SyntaxCheck would fail since currentoken is not part of the stopset - we check to see whether any of currenttoken might be a commonly omitted token */ - if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2))) - {} /* empty. */ - } -} - - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == t) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (Pass1) - { - PeepToken (stopset0, stopset1, stopset2); - } - } - else - { - MissingToken (t); - } - SyntaxCheck (stopset0, stopset1, stopset2); -} - - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - curident = nameKey_makekey (mcLexBuf_currentstring); - /* - PushTF(makekey(currentstring), identtok) - */ - Expect (mcReserved_identtok, stopset0, stopset1, stopset2); -} - - -/* - string - -*/ - -static void string (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - /* - PushTF(makekey(currentstring), stringtok) ; - BuildString - */ - Expect (mcReserved_stringtok, stopset0, stopset1, stopset2); -} - - -/* - Integer - -*/ - -static void Integer (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - /* - PushTF(makekey(currentstring), integertok) ; - BuildNumber - */ - Expect (mcReserved_integertok, stopset0, stopset1, stopset2); -} - - -/* - Real - -*/ - -static void Real (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - /* - PushTF(makekey(currentstring), realtok) ; - BuildNumber - */ - Expect (mcReserved_realtok, stopset0, stopset1, stopset2); -} - - -/* - registerImport - looks up module, ident, and adds it to the - current module import list. -*/ - -static void registerImport (nameKey_Name ident, unsigned int scoped) -{ - decl_node n; - - n = decl_lookupDef (ident); - decl_addImportedModule (decl_getCurrentModule (), n, scoped); -} - - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_definitiontok) - { - DefinitionModule (stopset0, stopset1, stopset2); - } - else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) - { - /* avoid dangling else. */ - ImplementationOrProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50); - } -} - - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % enterScope (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % leaveScope % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupModule (curident); - decl_enterScope (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "program module", 14); - decl_leaveScope (); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % leaveScope ; leaveScope % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupImp (curident); - decl_enterScope (decl_lookupDef (curident)); - decl_enterScope (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "implementation module", 21); - decl_leaveScope (); - decl_leaveScope (); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_implementationtok) - { - ImplementationModule (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39); - } -} - - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_integertok) - { - Integer (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_realtok) - { - /* avoid dangling else. */ - Real (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: real number integer number", 44); - } -} - - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SimpleConstExpr (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SimpleConstExpr (stopset0, stopset1, stopset2); - } -} - - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_hashtok) - { - /* avoid dangling else. */ - Expect (mcReserved_hashtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_intok) - { - /* avoid dangling else. */ - Expect (mcReserved_intok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37); - } -} - - -/* - SimpleConstExpr := UnaryOrConstTerm { AddOperator - ConstTerm } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - UnaryOrConstTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - AddOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - UnaryOrConstTerm := '+' ConstTerm | - '-' ConstTerm | - ConstTerm - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ConstTerm (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ identifier { string - +", 88); - } -} - - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ortok) - { - /* avoid dangling else. */ - Expect (mcReserved_ortok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: OR - +", 24); - } -} - - -/* - ConstTerm := ConstFactor { MulOperator ConstFactor } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ConstFactor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - MulOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstFactor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_timestok) - { - Expect (mcReserved_timestok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_dividetok) - { - /* avoid dangling else. */ - Expect (mcReserved_dividetok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_divtok) - { - /* avoid dangling else. */ - Expect (mcReserved_divtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_modtok) - { - /* avoid dangling else. */ - Expect (mcReserved_modtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_remtok) - { - /* avoid dangling else. */ - Expect (mcReserved_remtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_andtok) - { - /* avoid dangling else. */ - Expect (mcReserved_andtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ambersandtok) - { - /* avoid dangling else. */ - Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39); - } -} - - -/* - ConstFactor := Number | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpression ')' | - 'NOT' ConstFactor | - ConstAttribute - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - ConstString (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstFactor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( identifier { string integer number real number", 84); - } -} - - -/* - ConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - string (stopset0, stopset1, stopset2); -} - - -/* - ComponentElement := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - ComponentValue := ComponentElement [ 'BY' ConstExpression ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ComponentElement (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ComponentValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ComponentValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Constructor := '{' [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lcbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - ArraySetRecordValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - ConstSetOrQualidentOrFunction := Qualident [ Constructor | - ConstActualParameters ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - Constructor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ConstActualParameters (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( {", 21); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - Constructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - ConstActualParameters := ActualParameters - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ActualParameters (stopset0, stopset1, stopset2); -} - - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstAttributeExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ConstAttributeExpression := Ident | '<' Qualident - ',' Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: < identifier", 30); - } -} - - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - AlignmentExpression (stopset0, stopset1, stopset2); - } -} - - -/* - AlignmentExpression := '(' ConstExpression ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - ByteAlignment (stopset0, stopset1, stopset2); - } -} - - -/* - TypeDeclaration := Ident - % VAR n: node ; % - - % n := makeTypeImp (curident) % - '=' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void TypeDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - decl_node n; - - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - n = decl_makeTypeImp (curident); - Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0, stopset1, stopset2); -} - - -/* - Type := ( SimpleType | ArrayType | RecordType | - SetType | PointerType | - ProcedureType ) - - first symbols:lparatok, lsbratok, proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok - - cannot reachend -*/ - -static void Type (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - SimpleType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_arraytok) - { - /* avoid dangling else. */ - ArrayType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_recordtok) - { - /* avoid dangling else. */ - RecordType (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok)) - { - /* avoid dangling else. */ - SetType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_pointertok) - { - /* avoid dangling else. */ - PointerType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80); - } -} - - -/* - SimpleType := Qualident [ SubrangeType ] | - Enumeration | SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - SubrangeType (stopset0, stopset1, stopset2); - } - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Enumeration (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - SubrangeType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: [ ( identifier", 32); - } -} - - -/* - Enumeration := '(' ( IdentList ) ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SubrangeType := '[' ConstExpression '..' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - ArrayType := 'ARRAY' SimpleType { ',' SimpleType } - 'OF' Type - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_arraytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - /* while */ - Expect (mcReserved_oftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); -} - - -/* - RecordType := 'RECORD' [ DefaultRecordAttributes ] - FieldListSequence 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_recordtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - DefaultRecordAttributes (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - FieldListSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - PragmaConstExpression (stopset0, stopset1, stopset2); -} - - -/* - PragmaConstExpression := [ '(' ConstExpression ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeExpression := Ident '(' ConstExpression - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - FieldListStatement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListStatement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - FieldList (stopset0, stopset1, stopset2); - } -} - - -/* - FieldList := IdentList ':' Type RecordFieldPragma | - 'CASE' CaseTag 'OF' Varient { '|' Varient } - [ 'ELSE' FieldListSequence ] 'END' - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - RecordFieldPragma (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - Expect (mcReserved_casetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - CaseTag (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Varient (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Varient (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: CASE identifier", 33); - } -} - - -/* - TagIdent := [ Ident ] - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } -} - - -/* - CaseTag := TagIdent [ ':' Qualident ] - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - TagIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0, stopset1, stopset2); - } -} - - -/* - Varient := [ VarientCaseLabelList ':' FieldListSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))) - { - VarientCaseLabelList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1, stopset2); - } -} - - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - VarientCaseLabels (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - VarientCaseLabels (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VarientCaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SilentConstExpression := SilentSimpleConstExpr [ - SilentRelation SilentSimpleConstExpr ] - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SilentSimpleConstExpr (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - SilentRelation (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SilentSimpleConstExpr (stopset0, stopset1, stopset2); - } -} - - -/* - SilentRelation := '=' | '#' | '<>' | '<' | - '<=' | '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void SilentRelation (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_hashtok) - { - /* avoid dangling else. */ - Expect (mcReserved_hashtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_intok) - { - /* avoid dangling else. */ - Expect (mcReserved_intok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37); - } -} - - -/* - SilentSimpleConstExpr := SilentUnaryOrConstTerm - { SilentAddOperator SilentConstTerm } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentSimpleConstExpr (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SilentUnaryOrConstTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - SilentAddOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SilentConstTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - SilentUnaryOrConstTerm := '+' SilentConstTerm | - '-' SilentConstTerm | - SilentConstTerm - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentUnaryOrConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SilentConstTerm (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SilentConstTerm (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - SilentConstTerm (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ { identifier string - +", 88); - } -} - - -/* - SilentAddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void SilentAddOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ortok) - { - /* avoid dangling else. */ - Expect (mcReserved_ortok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: OR - +", 24); - } -} - - -/* - SilentConstTerm := SilentConstFactor { SilentMulOperator - SilentConstFactor } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void SilentConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SilentConstFactor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - SilentMulOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstFactor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - SilentMulOperator := '*' | '/' | 'DIV' | - 'MOD' | 'REM' | 'AND' | - '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void SilentMulOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_timestok) - { - Expect (mcReserved_timestok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_dividetok) - { - /* avoid dangling else. */ - Expect (mcReserved_dividetok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_divtok) - { - /* avoid dangling else. */ - Expect (mcReserved_divtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_modtok) - { - /* avoid dangling else. */ - Expect (mcReserved_modtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_remtok) - { - /* avoid dangling else. */ - Expect (mcReserved_remtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_andtok) - { - /* avoid dangling else. */ - Expect (mcReserved_andtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ambersandtok) - { - /* avoid dangling else. */ - Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39); - } -} - - -/* - SilentConstFactor := Number | SilentConstString | - SilentConstSetOrQualidentOrFunction | - '(' SilentConstExpression ')' | - 'NOT' SilentConstFactor | - SilentConstAttribute - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void SilentConstFactor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - SilentConstString (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - SilentConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstFactor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - SilentConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( { identifier string integer number real number", 84); - } -} - - -/* - SilentConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void SilentConstString (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - string (stopset0, stopset1, stopset2); -} - - -/* - SilentConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' SilentConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void SilentConstAttribute (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SilentConstAttributeExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - SilentConstAttributeExpression := Ident | - '<' Ident ',' - SilentConstString - '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void SilentConstAttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstString (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: < identifier", 30); - } -} - - -/* - SilentComponentElement := SilentConstExpression - [ '..' SilentConstExpression ] - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentComponentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SilentComponentValue := SilentComponentElement [ - 'BY' SilentConstExpression ] - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentComponentValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SilentComponentElement (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SilentArraySetRecordValue := SilentComponentValue - { ',' SilentComponentValue } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentArraySetRecordValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SilentComponentValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentComponentValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SilentConstructor := '{' [ SilentArraySetRecordValue ] - '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void SilentConstructor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lcbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - SilentArraySetRecordValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - SilentConstSetOrQualidentOrFunction := SilentConstructor | - Qualident - [ SilentConstructor | - SilentActualParameters ] - - first symbols:identtok, lcbratok - - cannot reachend -*/ - -static void SilentConstSetOrQualidentOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - SilentConstructor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - SilentConstructor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - SilentActualParameters (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( {", 21); - } - } - /* end of optional [ | ] expression */ - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier {", 30); - } -} - - -/* - SilentElement := SilentConstExpression [ '..' SilentConstExpression ] - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SilentActualParameters := '(' [ SilentExpList ] - ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void SilentActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - SilentExpList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - SilentExpList := SilentConstExpression { ',' SilentConstExpression } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_settok) - { - Expect (mcReserved_settok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_packedsettok) - { - /* avoid dangling else. */ - Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31); - } - Expect (mcReserved_oftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0, stopset1, stopset2); -} - - -/* - PointerType := 'POINTER' 'TO' Type - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); -} - - -/* - ProcedureType := 'PROCEDURE' [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalTypeList (stopset0, stopset1, stopset2); - } -} - - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_rparatok) - { - Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ProcedureParameters (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44); - } -} - - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - OptReturnType (stopset0, stopset1, stopset2); - } -} - - -/* - OptReturnType := '[' Qualident ']' | - Qualident - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier [", 30); - } -} - - -/* - ProcedureParameters := ProcedureParameter { ',' - ProcedureParameter } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ProcedureParameter (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureParameter (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ProcedureParameter := '...' | 'VAR' FormalType | - FormalType - - first symbols:arraytok, identtok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - FormalType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42); - } -} - - -/* - VarIdent := Ident - % VAR n: node ; % - - % n := makeVar (curident) % - [ '[' ConstExpression ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - decl_node n; - - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - n = decl_makeVar (curident); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } -} - - -/* - VarIdentList := VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - VarIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - VarIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VariableDeclaration := VarIdentList ':' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - VarIdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0, stopset1, stopset2); -} - - -/* - Designator := Qualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SubDesignator := '.' Ident | '[' ArrayExpList ']' | - '^' - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - Expect (mcReserved_lsbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ArrayExpList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_uparrowtok) - { - /* avoid dangling else. */ - Expect (mcReserved_uparrowtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ^ [ .", 23); - } -} - - -/* - ArrayExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Expression := SimpleExpression [ Relation SimpleExpression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - SimpleExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SimpleExpression := UnaryOrTerm { AddOperator Term } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - UnaryOrTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - AddOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - UnaryOrTerm := '+' Term | '-' Term | - Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - Term (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number identifier { - +", 74); - } -} - - -/* - Term := Factor { MulOperator Factor } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Factor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - MulOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Factor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - Factor := Number | string | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor | ConstAttribute ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - string (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - SetOrDesignatorOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Factor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( identifier { string integer number real number", 70); - } -} - - -/* - SetOrDesignatorOrFunction := Qualident [ Constructor | - SimpleDes - [ ActualParameters ] ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - Constructor (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))))) != 0))) - { - /* avoid dangling else. */ - SimpleDes (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - ActualParameters (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( ^ [ . {", 27); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - Constructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - SimpleDes := { SubDesignator } - - first symbols:periodtok, lsbratok, uparrowtok - - reachend -*/ - -static void SimpleDes (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ActualParameters := '(' [ ExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ExpList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ExitStatement := 'EXIT' - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_exittok, stopset0, stopset1, stopset2); -} - - -/* - ReturnStatement := 'RETURN' [ Expression ] - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_returntok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Expression (stopset0, stopset1, stopset2); - } -} - - -/* - Statement := [ AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement ] - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok - - reachend -*/ - -static void Statement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - AssignmentOrProcedureCall (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_iftok) - { - /* avoid dangling else. */ - IfStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - CaseStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_whiletok) - { - /* avoid dangling else. */ - WhileStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_repeattok) - { - /* avoid dangling else. */ - RepeatStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_looptok) - { - /* avoid dangling else. */ - LoopStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_fortok) - { - /* avoid dangling else. */ - ForStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_withtok) - { - /* avoid dangling else. */ - WithStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_asmtok) - { - /* avoid dangling else. */ - AsmStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_exittok) - { - /* avoid dangling else. */ - ExitStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_returntok) - { - /* avoid dangling else. */ - ReturnStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_retrytok) - { - /* avoid dangling else. */ - RetryStatement (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: RETRY RETURN EXIT ASM WITH FOR LOOP REPEAT WHILE CASE IF identifier", 85); - } - } - /* end of optional [ | ] expression */ -} - - -/* - RetryStatement := 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_retrytok, stopset0, stopset1, stopset2); -} - - -/* - AssignmentOrProcedureCall := Designator ( ':=' Expression | - ActualParameters | - - % epsilon % - ) - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Designator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_becomestok) - { - Expect (mcReserved_becomestok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ActualParameters (stopset0, stopset1, stopset2); - } - /* epsilon */ -} - - -/* - StatementSequence := Statement { ';' Statement } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Statement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Statement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - IfStatement := 'IF' Expression 'THEN' StatementSequence - { 'ELSIF' Expression 'THEN' StatementSequence } - [ 'ELSE' StatementSequence ] 'END' - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_iftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - Expect (mcReserved_thentok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_elsiftok) - { - Expect (mcReserved_elsiftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - Expect (mcReserved_thentok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - CaseStatement := 'CASE' Expression 'OF' Case { '|' - Case } - CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_casetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Case (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Case (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - CaseEndStatement (stopset0, stopset1, stopset2); -} - - -/* - CaseEndStatement := 'END' | 'ELSE' StatementSequence - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_endtok) - { - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - /* avoid dangling else. */ - Expect (mcReserved_elsetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ELSE END", 26); - } -} - - -/* - Case := [ CaseLabelList ':' StatementSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))) - { - CaseLabelList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1, stopset2); - } -} - - -/* - CaseLabelList := CaseLabels { ',' CaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - CaseLabels (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - CaseLabels (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - WhileStatement := 'WHILE' Expression 'DO' StatementSequence - 'END' - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_whiletok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - RepeatStatement := 'REPEAT' StatementSequence 'UNTIL' - Expression - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_repeattok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok)))); - Expect (mcReserved_untiltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); -} - - -/* - ForStatement := 'FOR' Ident ':=' Expression 'TO' - Expression [ 'BY' ConstExpression ] - 'DO' StatementSequence 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_becomestok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_dotok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - LoopStatement := 'LOOP' StatementSequence 'END' - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_looptok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - WithStatement := 'WITH' Designator 'DO' StatementSequence - 'END' - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Designator (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - ProcedureHeading (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - ProcedureBlock (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); -} - - -/* - DefProcedureIdent := Ident - % curproc := makeProcedure (curident) ; - setProcedureComment (lastcomment, curident) ; - putCommentDefProcedure (curproc) ; - % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefProcedureIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_makeProcedure (curident); - mcComment_setProcedureComment (mcLexBuf_lastcomment, curident); - decl_putCommentDefProcedure (curproc); -} - - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) ; - IF curproc=NIL - THEN - curproc := makeProcedure (curident) - END ; - setProcedureComment (lastcomment, curident) ; - putCommentModProcedure (curproc) ; - % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_lookupSym (curident); - if (curproc == NULL) - { - curproc = decl_makeProcedure (curident); - } - mcComment_setProcedureComment (mcLexBuf_lastcomment, curident); - decl_putCommentModProcedure (curproc); -} - - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42); - } - } - /* end of optional [ | ] expression */ -} - - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent - % enterScope (curproc) % - [ FormalParameters ] AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - decl_enterScope (curproc); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalParameters (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_builtintok) - { - Expect (mcReserved_builtintok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40); - } - } - /* end of optional [ | ] expression */ -} - - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Builtin (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefProcedureIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - DefFormalParameters (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - % leaveScope % - - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - ProcedureBlockBody (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - decl_leaveScope (); -} - - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - InitialBlock (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2); - FinalBlock (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - InitialBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_finallytok) - { - Expect (mcReserved_finallytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - FinalBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - NormalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - ExceptionalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration ';' } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - ConstantDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ModuleDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49); - } -} - - -/* - DefFormalParameters := '(' [ DefMultiFPSection ] - ')' FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - DefMultiFPSection (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - DefExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - DefMultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FormalParameters := '(' [ MultiFPSection ] ')' - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - MultiFPSection (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - AttributeNoReturn := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeUnused := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - ExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - MultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - NonVarFPSection (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - VarFPSection (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR identifier", 32); - } -} - - -/* - DefExtendedFP := DefOptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - DefOptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - OptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - VarFPSection := 'VAR' IdentList ':' FormalType [ - AttributeUnused ] - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } -} - - -/* - NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ] - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } -} - - -/* - OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ] - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - DefOptArg := '[' Ident ':' FormalType '=' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - FormalType := { 'ARRAY' 'OF' } Qualident - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_arraytok) - { - Expect (mcReserved_arraytok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - Qualident (stopset0, stopset1, stopset2); -} - - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - Block (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); -} - - -/* - Priority := '[' ConstExpression ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_exporttok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_qualifiedtok) - { - Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok) - { - /* avoid dangling else. */ - Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50); - } - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - FromImport := 'FROM' Ident - % registerImport (curident, FALSE) % - 'IMPORT' IdentList ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2); - registerImport (curident, FALSE); - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - ImportModuleList := Ident - % registerImport (curident, TRUE) % - { ',' Ident - % registerImport (curident, TRUE) % - } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - registerImport (curident, TRUE); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - registerImport (curident, TRUE); - } - /* while */ -} - - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ImportModuleList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_fromtok) - { - FromImport (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_importtok) - { - /* avoid dangling else. */ - WithoutFromImport (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29); - } -} - - -/* - DefinitionModule := - % VAR c: BOOLEAN ; % - - % c := FALSE % - 'DEFINITION' 'MODULE' [ 'FOR' - string - - % c := TRUE % - ] Ident - ';' - % curmodule := lookupDef (curident) % - - % IF c THEN putDefForC (curmodule) END % - - % enterScope (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % leaveScope % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - unsigned int c; - - c = FALSE; - Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_fortok) - { - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - c = TRUE; - } - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - curmodule = decl_lookupDef (curident); - if (c) - { - decl_putDefForC (curmodule); - } - decl_enterScope (curmodule); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Definition (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "definition module", 17); - decl_leaveScope (); -} - - -/* - DefTypeDeclaration := { Ident - % VAR n: node ; % - - % n := makeType (curident) % - ( ';' - % putTypeHidden (n) % - | '=' Type Alignment - ';' ) } - - first symbols:identtok - - reachend -*/ - -static void DefTypeDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - decl_node n; - - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - n = decl_makeType (curident); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - decl_putTypeHidden (n); - } - else if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: = ;", 21); - } - } - /* while */ -} - - -/* - ConstantDeclaration := Ident - % VAR n: node ; % - - % n := makeConst (curident) % - '=' ConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - decl_node n; - - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - n = decl_makeConst (curident); - Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); -} - - -/* - Definition := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { DefTypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - ConstantDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - DefTypeDeclaration (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - DefProcedureHeading (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42); - } -} - - -/* - AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_asmtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_volatiletok) - { - Expect (mcReserved_volatiletok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmOperands (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - string (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - AsmOperandSpec (stopset0, stopset1, stopset2); - } -} - - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - TrashList (stopset0, stopset1, stopset2); - } - } - } -} - - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok)) - { - AsmElement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmElement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - NamedOperand (stopset0, stopset1, stopset2); - } -} - - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - AsmOperandName (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - string (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp1_CompilationUnit (void) -{ - WasNoError = TRUE; - FileUnit ((mcp1_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp1_SetOfStop1) 0, (mcp1_SetOfStop2) 0); - return WasNoError; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcp1_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcp1_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gmcp2.c b/gcc/m2/mc-boot/Gmcp2.c deleted file mode 100644 index 85fd19326df4..000000000000 --- a/gcc/m2/mc-boot/Gmcp2.c +++ /dev/null @@ -1,7637 +0,0 @@ -/* do not edit automatically generated by mc from mcp2. */ -/* output from mc-2.bnf, automatically generated do not edit. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING. If not, -see . */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcp2_H -#define _mcp2_C - -# include "GDynamicStrings.h" -# include "GmcError.h" -# include "GnameKey.h" -# include "GmcPrintf.h" -# include "GmcDebug.h" -# include "GmcReserved.h" -# include "GmcLexBuf.h" -# include "Gdecl.h" - -# define Pass1 FALSE -# define Debugging FALSE -typedef unsigned int mcp2_stop0; - -typedef unsigned int mcp2_SetOfStop0; - -typedef unsigned int mcp2_stop1; - -typedef unsigned int mcp2_SetOfStop1; - -typedef unsigned int mcp2_stop2; - -typedef unsigned int mcp2_SetOfStop2; - -static unsigned int WasNoError; -static nameKey_Name curident; -static decl_node typeDes; -static decl_node typeExp; -static decl_node curproc; -static decl_node curmodule; - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp2_CompilationUnit (void); -static void ErrorString (DynamicStrings_String s); -static void ErrorArray (const char *a_, unsigned int _a_high); - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high); - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void); - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t); - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t); - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - string - -*/ - -static void string (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Integer - -*/ - -static void Integer (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Real - -*/ - -static void Real (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - registerImport - looks up module, ident, and adds it to the - current module import list. -*/ - -static void registerImport (nameKey_Name ident, unsigned int scoped); - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % enterScope (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % leaveScope % - - % setEnumsComplete (curmodule) % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % leaveScope ; leaveScope % - - % setEnumsComplete (curmodule) % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstantDeclaration := Ident '=' ConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SimpleConstExpr := UnaryOrConstTerm { AddOperator - ConstTerm } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - UnaryOrConstTerm := '+' ConstTerm | - '-' ConstTerm | - ConstTerm - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstTerm := ConstFactor { MulOperator ConstFactor } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstFactor := Number | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpression ')' | - 'NOT' ConstFactor | - ConstAttribute - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ComponentElement := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ComponentValue := ComponentElement [ 'BY' ConstExpression ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Constructor := '{' [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstSetOrQualidentOrFunction := Qualident [ Constructor | - ConstActualParameters ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstActualParameters := ActualParameters - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ConstAttributeExpression := Ident | '<' Qualident - ',' Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AlignmentExpression := '(' ConstExpression ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - TypeDeclaration := Ident - % typeDes := lookupSym (curident) % - '=' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void TypeDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Type := ( DefSimpleType | ArrayType | - RecordType | SetType | PointerType | - ProcedureType ) - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void Type (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SimpleType := Qualident [ SubrangeType ] | - Enumeration | SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - EnumIdentList := - % VAR n, f: node ; % - - % n := makeEnum () % - Ident - % f := makeEnumField (n, curident) % - { ',' Ident - % f := makeEnumField (n, curident) % - } - - first symbols:identtok - - cannot reachend -*/ - -static void EnumIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Enumeration := '(' ( EnumIdentList ) ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SubrangeType := '[' ConstExpression '..' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ArrayType := 'ARRAY' SimpleType { ',' SimpleType } - 'OF' Type - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - RecordType := 'RECORD' [ DefaultRecordAttributes ] - FieldListSequence 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - PragmaConstExpression := [ '(' ConstExpression ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AttributeExpression := Ident '(' ConstExpression - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FieldList := IdentList ':' Type RecordFieldPragma | - 'CASE' CaseTag 'OF' Varient { '|' Varient } - [ 'ELSE' FieldListSequence ] 'END' - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - TagIdent := [ Ident ] - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - CaseTag := TagIdent [ ':' Qualident ] - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Varient := [ VarientCaseLabelList ':' FieldListSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - VarientCaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentConstExpression := SilentSimpleConstExpr [ - SilentRelation SilentSimpleConstExpr ] - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentRelation := '=' | '#' | '<>' | '<' | - '<=' | '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void SilentRelation (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentSimpleConstExpr := SilentUnaryOrConstTerm - { SilentAddOperator SilentConstTerm } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentSimpleConstExpr (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentUnaryOrConstTerm := '+' SilentConstTerm | - '-' SilentConstTerm | - SilentConstTerm - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentUnaryOrConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentAddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void SilentAddOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentConstTerm := SilentConstFactor { SilentMulOperator - SilentConstFactor } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void SilentConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentMulOperator := '*' | '/' | 'DIV' | - 'MOD' | 'REM' | 'AND' | - '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void SilentMulOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentConstFactor := Number | SilentConstString | - SilentConstSetOrQualidentOrFunction | - '(' SilentConstExpression ')' | - 'NOT' SilentConstFactor | - SilentConstAttribute - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void SilentConstFactor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void SilentConstString (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' SilentConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void SilentConstAttribute (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentConstAttributeExpression := Ident | - '<' Ident ',' - SilentConstString - '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void SilentConstAttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentComponentElement := SilentConstExpression - [ '..' SilentConstExpression ] - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentComponentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentComponentValue := SilentComponentElement [ - 'BY' SilentConstExpression ] - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentComponentValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentArraySetRecordValue := SilentComponentValue - { ',' SilentComponentValue } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentArraySetRecordValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentConstructor := '{' [ SilentArraySetRecordValue ] - '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void SilentConstructor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentConstSetOrQualidentOrFunction := SilentConstructor | - Qualident - [ SilentConstructor | - SilentActualParameters ] - - first symbols:identtok, lcbratok - - cannot reachend -*/ - -static void SilentConstSetOrQualidentOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentElement := SilentConstExpression [ '..' SilentConstExpression ] - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentActualParameters := '(' [ SilentExpList ] - ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void SilentActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SilentExpList := SilentConstExpression { ',' SilentConstExpression } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - PointerType := 'POINTER' 'TO' Type - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProcedureType := 'PROCEDURE' [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - OptReturnType := '[' Qualident ']' | - Qualident - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProcedureParameters := ProcedureParameter { ',' - ProcedureParameter } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProcedureParameter := '...' | 'VAR' FormalType | - FormalType - - first symbols:arraytok, identtok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - VarIdent := Ident [ '[' ConstExpression ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - VarIdentList := VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - VariableDeclaration := VarIdentList ':' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefVarIdent := Ident [ '[' ConstExpression ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void DefVarIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefVarIdentList := DefVarIdent { ',' DefVarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void DefVarIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefVariableDeclaration := - % typeDes := NIL % - DefVarIdentList ':' Type - Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void DefVariableDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Designator := Qualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SubDesignator := '.' Ident | '[' ArrayExpList ']' | - '^' - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ArrayExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Expression := SimpleExpression [ Relation SimpleExpression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SimpleExpression := UnaryOrTerm { AddOperator Term } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - UnaryOrTerm := '+' Term | '-' Term | - Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Term := Factor { MulOperator Factor } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Factor := Number | string | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor | ConstAttribute ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SetOrDesignatorOrFunction := Qualident [ Constructor | - SimpleDes - [ ActualParameters ] ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - SimpleDes := { SubDesignator } - - first symbols:periodtok, lsbratok, uparrowtok - - reachend -*/ - -static void SimpleDes (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ActualParameters := '(' [ ExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ExitStatement := 'EXIT' - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ReturnStatement := 'RETURN' [ Expression ] - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Statement := [ AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement ] - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok - - reachend -*/ - -static void Statement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - RetryStatement := 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AssignmentOrProcedureCall := Designator ( ':=' Expression | - ActualParameters | - - % epsilon % - ) - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - StatementSequence := Statement { ';' Statement } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - IfStatement := 'IF' Expression 'THEN' StatementSequence - { 'ELSIF' Expression 'THEN' StatementSequence } - [ 'ELSE' StatementSequence ] 'END' - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - CaseStatement := 'CASE' Expression 'OF' Case { '|' - Case } - CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - CaseEndStatement := 'END' | 'ELSE' StatementSequence - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Case := [ CaseLabelList ':' StatementSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - CaseLabelList := CaseLabels { ',' CaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - CaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - WhileStatement := 'WHILE' Expression 'DO' StatementSequence - 'END' - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - RepeatStatement := 'REPEAT' StatementSequence 'UNTIL' - Expression - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ForStatement := 'FOR' Ident ':=' Expression 'TO' - Expression [ 'BY' ConstExpression ] - 'DO' StatementSequence 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - LoopStatement := 'LOOP' StatementSequence 'END' - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - WithStatement := 'WITH' Designator 'DO' StatementSequence - 'END' - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent - % enterScope (curproc) % - [ FormalParameters ] AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( ProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - % leaveScope % - - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - NormalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ExceptionalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration ';' } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefFormalParameters := '(' [ DefMultiFPSection ] - ')' FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FormalParameters := '(' [ MultiFPSection ] ')' - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AttributeNoReturn := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AttributeUnused := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefExtendedFP := DefOptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - VarFPSection := 'VAR' IdentList ':' FormalType [ - AttributeUnused ] - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ] - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ] - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefOptArg := '[' Ident ':' FormalType '=' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FormalType := { 'ARRAY' 'OF' } Qualident - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Priority := '[' ConstExpression ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - FromImport := 'FROM' Ident 'IMPORT' IdentList ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - ImportModuleList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR' - string ] - Ident ';' - % curmodule := lookupDef (curident) % - - % enterScope (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % leaveScope % - - % setEnumsComplete (curmodule) % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefQualident := Ident - % typeExp := lookupSym (curident) % - [ '.' - % IF NOT isDef (typeExp) - THEN - ErrorArray ('the first component of this qualident must be a definition module') - END % - Ident - % typeExp := lookupInScope (typeExp, curident) ; - IF typeExp=NIL - THEN - ErrorArray ('identifier not found in definition module') - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void DefQualident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefOptSubrange := [ SubrangeType | - - % putType (typeDes, typeExp) % - ] - - first symbols:lsbratok - - reachend -*/ - -static void DefOptSubrange (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefTypeEquiv := DefQualident DefOptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void DefTypeEquiv (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefEnumIdentList := - % VAR n, f: node ; % - - % n := makeEnum () % - Ident - % f := makeEnumField (n, curident) % - { ',' Ident - % f := makeEnumField (n, curident) % - } - % IF typeDes # NIL THEN putType (typeDes, n) END % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefEnumIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefEnumeration := '(' DefEnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void DefEnumeration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefSimpleType := DefTypeEquiv | DefEnumeration | - SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void DefSimpleType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefType := DefSimpleType | ArrayType | - RecordType | SetType | PointerType | - ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void DefType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefTypeDeclaration := { Ident - % typeDes := lookupSym (curident) % - ( ';' | '=' DefType Alignment - ';' ) } - - first symbols:identtok - - reachend -*/ - -static void DefTypeDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - DefConstantDeclaration := Ident '=' ConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void DefConstantDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - Definition := 'CONST' { DefConstantDeclaration ';' } | - 'TYPE' { DefTypeDeclaration } | - 'VAR' { DefVariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2); - -static void ErrorString (DynamicStrings_String s) -{ - mcError_errorStringAt (s, mcLexBuf_getTokenNo ()); - WasNoError = FALSE; -} - -static void ErrorArray (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - ErrorString (DynamicStrings_InitString ((const char *) a, _a_high)); -} - - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high) -{ - DynamicStrings_String s; - char desc[_desc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (desc, desc_, _desc_high+1); - - if ((decl_getSymName (module)) != name) - { - s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41); - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high))); - ErrorString (s); - } -} - - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - unsigned int n; - DynamicStrings_String str; - DynamicStrings_String message; - - n = 0; - message = DynamicStrings_InitString ((const char *) "", 0); - if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6))); - n += 1; - } - if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11))); - n += 1; - } - if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10))); - n += 1; - } - if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14))); - n += 1; - } - if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10))); - n += 1; - } - if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11))); - n += 1; - } - if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13))); - n += 1; - } - if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3))); - n += 1; - } - if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8))); - n += 1; - } - if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3))); - n += 1; - } - if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4))); - n += 1; - } - if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5))); - n += 1; - } - if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3))); - n += 1; - } - if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5))); - n += 1; - } - if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4))); - n += 1; - } - if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2))); - n += 1; - } - if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4))); - n += 1; - } - if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3))); - n += 1; - } - if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6))); - n += 1; - } - if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5))); - n += 1; - } - if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6))); - n += 1; - } - if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3))); - n += 1; - } - if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6))); - n += 1; - } - if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11))); - n += 1; - } - if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9))); - n += 1; - } - if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9))); - n += 1; - } - if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7))); - n += 1; - } - if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9))); - n += 1; - } - if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2))); - n += 1; - } - if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2))); - n += 1; - } - if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3))); - n += 1; - } - if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6))); - n += 1; - } - if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3))); - n += 1; - } - if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4))); - n += 1; - } - if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2))); - n += 1; - } - if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14))); - n += 1; - } - if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2))); - n += 1; - } - if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4))); - n += 1; - } - if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3))); - n += 1; - } - if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7))); - n += 1; - } - if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4))); - n += 1; - } - if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6))); - n += 1; - } - if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3))); - n += 1; - } - if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5))); - n += 1; - } - if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4))); - n += 1; - } - if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2))); - n += 1; - } - if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3))); - n += 1; - } - if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10))); - n += 1; - } - if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5))); - n += 1; - } - if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4))); - n += 1; - } - if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2))); - n += 1; - } - if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5))); - n += 1; - } - if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5))); - n += 1; - } - if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3))); - n += 1; - } - if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2))); - n += 1; - } - if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2))); - n += 1; - } - if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2))); - n += 1; - } - if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2))); - n += 1; - } - if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1))); - n += 1; - } - if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1))); - n += 1; - } - if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1))); - n += 1; - } - if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1))); - n += 1; - } - if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))); - n += 1; - } - if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1))); - n += 1; - } - if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1))); - n += 1; - } - if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1))); - n += 1; - } - if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1))); - n += 1; - } - if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1))); - n += 1; - } - if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ','); - n += 1; - } - if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ','); - n += 1; - } - if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1))); - n += 1; - } - if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1))); - n += 1; - } - if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1))); - n += 1; - } - if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1))); - n += 1; - } - if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1))); - n += 1; - } - if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1))); - n += 1; - } - if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1))); - n += 1; - } - if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1))); - n += 1; - } - if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1))); - n += 1; - } - if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2))); - n += 1; - } - if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0)) - {} /* empty. */ - /* eoftok has no token name (needed to generate error messages) */ - if (n == 0) - { - str = DynamicStrings_InitString ((const char *) " syntax error", 13); - message = DynamicStrings_KillString (message); - } - else if (n == 1) - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9))); - } - else - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message); - message = DynamicStrings_KillString (message); - } - return str; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void) -{ - DynamicStrings_String str; - - str = DynamicStrings_InitString ((const char *) "", 0); - switch (mcLexBuf_currenttoken) - { - case mcReserved_stringtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_realtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_identtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_integertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_inlinetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_builtintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_attributetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str)); - break; - - case mcReserved_filetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_linetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_datetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_volatiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_asmtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_withtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_whiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_vartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_untiltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_typetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_totok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_thentok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_settok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_returntok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_retrytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_repeattok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_remtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_recordtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_unqualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_qualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_proceduretok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_pointertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_packedsettok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_ortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_oftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_nottok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_moduletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_modtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_looptok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_intok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_importtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_implementationtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_iftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_fromtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_fortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_finallytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_exporttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_exittok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_excepttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_endtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsiftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_dotok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_divtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_definitiontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_consttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_casetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_bytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_begintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_arraytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_andtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_colontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_rdirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_ldirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_greaterequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessgreatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_hashtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_equaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_uparrowtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_semicolontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_commatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_ambersandtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_dividetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_timestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_minustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_plustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_doublequotestok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str)); - break; - - case mcReserved_singlequotetok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str)); - break; - - case mcReserved_greatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lesstok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_bartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_becomestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_eoftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str)); - break; - - - default: - break; - } - ErrorString (str); -} - - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - DescribeError (); - if (Debugging) - { - mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21); - } - /* - yes the ORD(currenttoken) looks ugly, but it is *much* safer than - using currenttoken= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - mcLexBuf_getToken (); - } - if (Debugging) - { - mcPrintf_printf0 ((const char *) " ***\\n", 6); - } -} - - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - SyntaxError (stopset0, stopset1, stopset2); - } -} - - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t) -{ - mcp2_SetOfStop0 s0; - mcp2_SetOfStop1 s1; - mcp2_SetOfStop2 s2; - DynamicStrings_String str; - - s0 = (mcp2_SetOfStop0) 0; - s1 = (mcp2_SetOfStop1) 0; - s2 = (mcp2_SetOfStop2) 0; - if ( ((unsigned int) (t)) < 32) - { - s0 = (mcp2_SetOfStop0) ((1 << (t-mcReserved_eoftok))); - } - else if ( ((unsigned int) (t)) < 64) - { - /* avoid dangling else. */ - s1 = (mcp2_SetOfStop1) ((1 << (t-mcReserved_arraytok))); - } - else - { - /* avoid dangling else. */ - s2 = (mcp2_SetOfStop2) ((1 << (t-mcReserved_recordtok))); - } - str = DescribeStop (s0, s1, s2); - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str)); - mcError_errorStringAt (str, mcLexBuf_getTokenNo ()); -} - - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t) -{ - WarnMissingToken (t); - if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok)) - { - if (Debugging) - { - mcPrintf_printf0 ((const char *) "inserting token\\n", 17); - } - mcLexBuf_insertToken (t); - } -} - - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - WarnMissingToken (t); - mcLexBuf_insertTokenAndRewind (t); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2)))) - { - /* SyntaxCheck would fail since currentoken is not part of the stopset - we check to see whether any of currenttoken might be a commonly omitted token */ - if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2))) - {} /* empty. */ - } -} - - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == t) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (Pass1) - { - PeepToken (stopset0, stopset1, stopset2); - } - } - else - { - MissingToken (t); - } - SyntaxCheck (stopset0, stopset1, stopset2); -} - - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - curident = nameKey_makekey (mcLexBuf_currentstring); - Expect (mcReserved_identtok, stopset0, stopset1, stopset2); -} - - -/* - string - -*/ - -static void string (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - /* - PushTF(makekey(currentstring), stringtok) ; - BuildString - */ - Expect (mcReserved_stringtok, stopset0, stopset1, stopset2); -} - - -/* - Integer - -*/ - -static void Integer (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - /* - PushTF(makekey(currentstring), integertok) ; - BuildNumber - */ - Expect (mcReserved_integertok, stopset0, stopset1, stopset2); -} - - -/* - Real - -*/ - -static void Real (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - /* - PushTF(makekey(currentstring), realtok) ; - BuildNumber - */ - Expect (mcReserved_realtok, stopset0, stopset1, stopset2); -} - - -/* - registerImport - looks up module, ident, and adds it to the - current module import list. -*/ - -static void registerImport (nameKey_Name ident, unsigned int scoped) -{ - decl_node n; - - n = decl_lookupDef (ident); - decl_addImportedModule (decl_getCurrentModule (), n, scoped); -} - - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_definitiontok) - { - DefinitionModule (stopset0, stopset1, stopset2); - } - else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) - { - /* avoid dangling else. */ - ImplementationOrProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50); - } -} - - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % enterScope (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % leaveScope % - - % setEnumsComplete (curmodule) % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupModule (curident); - decl_enterScope (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "program module", 14); - decl_leaveScope (); - decl_setEnumsComplete (curmodule); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % leaveScope ; leaveScope % - - % setEnumsComplete (curmodule) % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupImp (curident); - decl_enterScope (decl_lookupDef (curident)); - decl_enterScope (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "implementation module", 21); - decl_leaveScope (); - decl_leaveScope (); - decl_setEnumsComplete (curmodule); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_implementationtok) - { - ImplementationModule (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39); - } -} - - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_integertok) - { - Integer (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_realtok) - { - /* avoid dangling else. */ - Real (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: real number integer number", 44); - } -} - - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstantDeclaration := Ident '=' ConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); -} - - -/* - ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SimpleConstExpr (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SimpleConstExpr (stopset0, stopset1, stopset2); - } -} - - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_hashtok) - { - /* avoid dangling else. */ - Expect (mcReserved_hashtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_intok) - { - /* avoid dangling else. */ - Expect (mcReserved_intok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37); - } -} - - -/* - SimpleConstExpr := UnaryOrConstTerm { AddOperator - ConstTerm } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - UnaryOrConstTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - AddOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - UnaryOrConstTerm := '+' ConstTerm | - '-' ConstTerm | - ConstTerm - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ConstTerm (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ identifier { string - +", 88); - } -} - - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ortok) - { - /* avoid dangling else. */ - Expect (mcReserved_ortok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: OR - +", 24); - } -} - - -/* - ConstTerm := ConstFactor { MulOperator ConstFactor } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ConstFactor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - MulOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstFactor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_timestok) - { - Expect (mcReserved_timestok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_dividetok) - { - /* avoid dangling else. */ - Expect (mcReserved_dividetok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_divtok) - { - /* avoid dangling else. */ - Expect (mcReserved_divtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_modtok) - { - /* avoid dangling else. */ - Expect (mcReserved_modtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_remtok) - { - /* avoid dangling else. */ - Expect (mcReserved_remtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_andtok) - { - /* avoid dangling else. */ - Expect (mcReserved_andtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ambersandtok) - { - /* avoid dangling else. */ - Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39); - } -} - - -/* - ConstFactor := Number | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpression ')' | - 'NOT' ConstFactor | - ConstAttribute - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - ConstString (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstFactor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( identifier { string integer number real number", 84); - } -} - - -/* - ConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - string (stopset0, stopset1, stopset2); -} - - -/* - ComponentElement := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - ComponentValue := ComponentElement [ 'BY' ConstExpression ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ComponentElement (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ComponentValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ComponentValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Constructor := '{' [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lcbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - ArraySetRecordValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - ConstSetOrQualidentOrFunction := Qualident [ Constructor | - ConstActualParameters ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - Constructor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ConstActualParameters (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( {", 21); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - Constructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - ConstActualParameters := ActualParameters - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ActualParameters (stopset0, stopset1, stopset2); -} - - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstAttributeExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ConstAttributeExpression := Ident | '<' Qualident - ',' Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: < identifier", 30); - } -} - - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - AlignmentExpression (stopset0, stopset1, stopset2); - } -} - - -/* - AlignmentExpression := '(' ConstExpression ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - ByteAlignment (stopset0, stopset1, stopset2); - } -} - - -/* - TypeDeclaration := Ident - % typeDes := lookupSym (curident) % - '=' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void TypeDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - typeDes = decl_lookupSym (curident); - Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0, stopset1, stopset2); -} - - -/* - Type := ( DefSimpleType | ArrayType | - RecordType | SetType | PointerType | - ProcedureType ) - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void Type (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - DefSimpleType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_arraytok) - { - /* avoid dangling else. */ - ArrayType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_recordtok) - { - /* avoid dangling else. */ - RecordType (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok)) - { - /* avoid dangling else. */ - SetType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_pointertok) - { - /* avoid dangling else. */ - PointerType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80); - } -} - - -/* - SimpleType := Qualident [ SubrangeType ] | - Enumeration | SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - SubrangeType (stopset0, stopset1, stopset2); - } - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Enumeration (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - SubrangeType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: [ ( identifier", 32); - } -} - - -/* - EnumIdentList := - % VAR n, f: node ; % - - % n := makeEnum () % - Ident - % f := makeEnumField (n, curident) % - { ',' Ident - % f := makeEnumField (n, curident) % - } - - first symbols:identtok - - cannot reachend -*/ - -static void EnumIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - decl_node n; - decl_node f; - - n = decl_makeEnum (); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - f = decl_makeEnumField (n, curident); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - f = decl_makeEnumField (n, curident); - } - /* while */ -} - - -/* - Enumeration := '(' ( EnumIdentList ) ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - EnumIdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SubrangeType := '[' ConstExpression '..' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - ArrayType := 'ARRAY' SimpleType { ',' SimpleType } - 'OF' Type - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_arraytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - /* while */ - Expect (mcReserved_oftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); -} - - -/* - RecordType := 'RECORD' [ DefaultRecordAttributes ] - FieldListSequence 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_recordtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - DefaultRecordAttributes (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - FieldListSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - PragmaConstExpression (stopset0, stopset1, stopset2); -} - - -/* - PragmaConstExpression := [ '(' ConstExpression ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeExpression := Ident '(' ConstExpression - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - FieldListStatement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListStatement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - FieldList (stopset0, stopset1, stopset2); - } -} - - -/* - FieldList := IdentList ':' Type RecordFieldPragma | - 'CASE' CaseTag 'OF' Varient { '|' Varient } - [ 'ELSE' FieldListSequence ] 'END' - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - RecordFieldPragma (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - Expect (mcReserved_casetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - CaseTag (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Varient (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Varient (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: CASE identifier", 33); - } -} - - -/* - TagIdent := [ Ident ] - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } -} - - -/* - CaseTag := TagIdent [ ':' Qualident ] - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - TagIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0, stopset1, stopset2); - } -} - - -/* - Varient := [ VarientCaseLabelList ':' FieldListSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))) - { - VarientCaseLabelList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1, stopset2); - } -} - - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - VarientCaseLabels (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - VarientCaseLabels (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VarientCaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SilentConstExpression := SilentSimpleConstExpr [ - SilentRelation SilentSimpleConstExpr ] - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SilentSimpleConstExpr (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - SilentRelation (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SilentSimpleConstExpr (stopset0, stopset1, stopset2); - } -} - - -/* - SilentRelation := '=' | '#' | '<>' | '<' | - '<=' | '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void SilentRelation (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_hashtok) - { - /* avoid dangling else. */ - Expect (mcReserved_hashtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_intok) - { - /* avoid dangling else. */ - Expect (mcReserved_intok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37); - } -} - - -/* - SilentSimpleConstExpr := SilentUnaryOrConstTerm - { SilentAddOperator SilentConstTerm } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentSimpleConstExpr (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SilentUnaryOrConstTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - SilentAddOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SilentConstTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - SilentUnaryOrConstTerm := '+' SilentConstTerm | - '-' SilentConstTerm | - SilentConstTerm - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentUnaryOrConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SilentConstTerm (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SilentConstTerm (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - SilentConstTerm (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ { identifier string - +", 88); - } -} - - -/* - SilentAddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void SilentAddOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ortok) - { - /* avoid dangling else. */ - Expect (mcReserved_ortok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: OR - +", 24); - } -} - - -/* - SilentConstTerm := SilentConstFactor { SilentMulOperator - SilentConstFactor } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void SilentConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SilentConstFactor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - SilentMulOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstFactor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - SilentMulOperator := '*' | '/' | 'DIV' | - 'MOD' | 'REM' | 'AND' | - '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void SilentMulOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_timestok) - { - Expect (mcReserved_timestok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_dividetok) - { - /* avoid dangling else. */ - Expect (mcReserved_dividetok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_divtok) - { - /* avoid dangling else. */ - Expect (mcReserved_divtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_modtok) - { - /* avoid dangling else. */ - Expect (mcReserved_modtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_remtok) - { - /* avoid dangling else. */ - Expect (mcReserved_remtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_andtok) - { - /* avoid dangling else. */ - Expect (mcReserved_andtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ambersandtok) - { - /* avoid dangling else. */ - Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39); - } -} - - -/* - SilentConstFactor := Number | SilentConstString | - SilentConstSetOrQualidentOrFunction | - '(' SilentConstExpression ')' | - 'NOT' SilentConstFactor | - SilentConstAttribute - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void SilentConstFactor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - SilentConstString (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - SilentConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstFactor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - SilentConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( { identifier string integer number real number", 84); - } -} - - -/* - SilentConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void SilentConstString (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - string (stopset0, stopset1, stopset2); -} - - -/* - SilentConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' SilentConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void SilentConstAttribute (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SilentConstAttributeExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - SilentConstAttributeExpression := Ident | - '<' Ident ',' - SilentConstString - '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void SilentConstAttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstString (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: < identifier", 30); - } -} - - -/* - SilentComponentElement := SilentConstExpression - [ '..' SilentConstExpression ] - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentComponentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SilentComponentValue := SilentComponentElement [ - 'BY' SilentConstExpression ] - - first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void SilentComponentValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SilentComponentElement (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SilentArraySetRecordValue := SilentComponentValue - { ',' SilentComponentValue } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentArraySetRecordValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SilentComponentValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentComponentValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SilentConstructor := '{' [ SilentArraySetRecordValue ] - '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void SilentConstructor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lcbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - SilentArraySetRecordValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - SilentConstSetOrQualidentOrFunction := SilentConstructor | - Qualident - [ SilentConstructor | - SilentActualParameters ] - - first symbols:identtok, lcbratok - - cannot reachend -*/ - -static void SilentConstSetOrQualidentOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - SilentConstructor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - SilentConstructor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - SilentActualParameters (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( {", 21); - } - } - /* end of optional [ | ] expression */ - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier {", 30); - } -} - - -/* - SilentElement := SilentConstExpression [ '..' SilentConstExpression ] - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SilentActualParameters := '(' [ SilentExpList ] - ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void SilentActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - SilentExpList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - SilentExpList := SilentConstExpression { ',' SilentConstExpression } - - first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SilentExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_settok) - { - Expect (mcReserved_settok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_packedsettok) - { - /* avoid dangling else. */ - Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31); - } - Expect (mcReserved_oftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0, stopset1, stopset2); -} - - -/* - PointerType := 'POINTER' 'TO' Type - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); -} - - -/* - ProcedureType := 'PROCEDURE' [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalTypeList (stopset0, stopset1, stopset2); - } -} - - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_rparatok) - { - Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ProcedureParameters (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44); - } -} - - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - OptReturnType (stopset0, stopset1, stopset2); - } -} - - -/* - OptReturnType := '[' Qualident ']' | - Qualident - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier [", 30); - } -} - - -/* - ProcedureParameters := ProcedureParameter { ',' - ProcedureParameter } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ProcedureParameter (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureParameter (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ProcedureParameter := '...' | 'VAR' FormalType | - FormalType - - first symbols:arraytok, identtok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - FormalType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42); - } -} - - -/* - VarIdent := Ident [ '[' ConstExpression ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } -} - - -/* - VarIdentList := VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - VarIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - VarIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VariableDeclaration := VarIdentList ':' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - VarIdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0, stopset1, stopset2); -} - - -/* - DefVarIdent := Ident [ '[' ConstExpression ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void DefVarIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } -} - - -/* - DefVarIdentList := DefVarIdent { ',' DefVarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void DefVarIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - DefVarIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefVarIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - DefVariableDeclaration := - % typeDes := NIL % - DefVarIdentList ':' Type - Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void DefVariableDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - typeDes = static_cast (NULL); - DefVarIdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0, stopset1, stopset2); -} - - -/* - Designator := Qualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SubDesignator := '.' Ident | '[' ArrayExpList ']' | - '^' - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ArrayExpList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_uparrowtok) - { - /* avoid dangling else. */ - Expect (mcReserved_uparrowtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ^ [ .", 23); - } -} - - -/* - ArrayExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Expression := SimpleExpression [ Relation SimpleExpression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - SimpleExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SimpleExpression := UnaryOrTerm { AddOperator Term } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - UnaryOrTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - AddOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - UnaryOrTerm := '+' Term | '-' Term | - Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - Term (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number identifier { - +", 74); - } -} - - -/* - Term := Factor { MulOperator Factor } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Factor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - MulOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Factor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - Factor := Number | string | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor | ConstAttribute ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - string (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - SetOrDesignatorOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Factor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( identifier { string integer number real number", 70); - } -} - - -/* - SetOrDesignatorOrFunction := Qualident [ Constructor | - SimpleDes - [ ActualParameters ] ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - Constructor (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))))) != 0))) - { - /* avoid dangling else. */ - SimpleDes (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - ActualParameters (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( ^ [ . {", 27); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - Constructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - SimpleDes := { SubDesignator } - - first symbols:periodtok, lsbratok, uparrowtok - - reachend -*/ - -static void SimpleDes (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ActualParameters := '(' [ ExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ExpList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ExitStatement := 'EXIT' - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_exittok, stopset0, stopset1, stopset2); -} - - -/* - ReturnStatement := 'RETURN' [ Expression ] - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_returntok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Expression (stopset0, stopset1, stopset2); - } -} - - -/* - Statement := [ AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement ] - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok - - reachend -*/ - -static void Statement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - AssignmentOrProcedureCall (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_iftok) - { - /* avoid dangling else. */ - IfStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - CaseStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_whiletok) - { - /* avoid dangling else. */ - WhileStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_repeattok) - { - /* avoid dangling else. */ - RepeatStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_looptok) - { - /* avoid dangling else. */ - LoopStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_fortok) - { - /* avoid dangling else. */ - ForStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_withtok) - { - /* avoid dangling else. */ - WithStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_asmtok) - { - /* avoid dangling else. */ - AsmStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_exittok) - { - /* avoid dangling else. */ - ExitStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_returntok) - { - /* avoid dangling else. */ - ReturnStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_retrytok) - { - /* avoid dangling else. */ - RetryStatement (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: RETRY RETURN EXIT ASM WITH FOR LOOP REPEAT WHILE CASE IF identifier", 85); - } - } - /* end of optional [ | ] expression */ -} - - -/* - RetryStatement := 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_retrytok, stopset0, stopset1, stopset2); -} - - -/* - AssignmentOrProcedureCall := Designator ( ':=' Expression | - ActualParameters | - - % epsilon % - ) - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Designator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_becomestok) - { - Expect (mcReserved_becomestok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ActualParameters (stopset0, stopset1, stopset2); - } - /* epsilon */ -} - - -/* - StatementSequence := Statement { ';' Statement } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Statement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Statement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - IfStatement := 'IF' Expression 'THEN' StatementSequence - { 'ELSIF' Expression 'THEN' StatementSequence } - [ 'ELSE' StatementSequence ] 'END' - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_iftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - Expect (mcReserved_thentok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_elsiftok) - { - Expect (mcReserved_elsiftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - Expect (mcReserved_thentok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - CaseStatement := 'CASE' Expression 'OF' Case { '|' - Case } - CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_casetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Case (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Case (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - CaseEndStatement (stopset0, stopset1, stopset2); -} - - -/* - CaseEndStatement := 'END' | 'ELSE' StatementSequence - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_endtok) - { - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - /* avoid dangling else. */ - Expect (mcReserved_elsetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ELSE END", 26); - } -} - - -/* - Case := [ CaseLabelList ':' StatementSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))) - { - CaseLabelList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1, stopset2); - } -} - - -/* - CaseLabelList := CaseLabels { ',' CaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - CaseLabels (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - CaseLabels (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - WhileStatement := 'WHILE' Expression 'DO' StatementSequence - 'END' - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_whiletok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - RepeatStatement := 'REPEAT' StatementSequence 'UNTIL' - Expression - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_repeattok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok)))); - Expect (mcReserved_untiltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); -} - - -/* - ForStatement := 'FOR' Ident ':=' Expression 'TO' - Expression [ 'BY' ConstExpression ] - 'DO' StatementSequence 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_becomestok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_dotok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - LoopStatement := 'LOOP' StatementSequence 'END' - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_looptok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - WithStatement := 'WITH' Designator 'DO' StatementSequence - 'END' - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Designator (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - ProcedureHeading (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - ProcedureBlock (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); -} - - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_lookupSym (curident); -} - - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42); - } - } - /* end of optional [ | ] expression */ -} - - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent - % enterScope (curproc) % - [ FormalParameters ] AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - decl_enterScope (curproc); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalParameters (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_builtintok) - { - Expect (mcReserved_builtintok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40); - } - } - /* end of optional [ | ] expression */ -} - - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( ProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Builtin (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - DefFormalParameters (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - % leaveScope % - - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - ProcedureBlockBody (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - decl_leaveScope (); -} - - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - InitialBlock (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2); - FinalBlock (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - InitialBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_finallytok) - { - Expect (mcReserved_finallytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - FinalBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - NormalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - ExceptionalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration ';' } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - ConstantDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ModuleDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49); - } -} - - -/* - DefFormalParameters := '(' [ DefMultiFPSection ] - ')' FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - DefMultiFPSection (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - DefExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - DefMultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FormalParameters := '(' [ MultiFPSection ] ')' - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - MultiFPSection (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - AttributeNoReturn := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeUnused := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - ExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - MultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - NonVarFPSection (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - VarFPSection (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR identifier", 32); - } -} - - -/* - DefExtendedFP := DefOptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - DefOptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - OptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - VarFPSection := 'VAR' IdentList ':' FormalType [ - AttributeUnused ] - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } -} - - -/* - NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ] - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } -} - - -/* - OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ] - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - DefOptArg := '[' Ident ':' FormalType '=' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - FormalType := { 'ARRAY' 'OF' } Qualident - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_arraytok) - { - Expect (mcReserved_arraytok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - Qualident (stopset0, stopset1, stopset2); -} - - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - Block (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); -} - - -/* - Priority := '[' ConstExpression ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_exporttok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_qualifiedtok) - { - Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok) - { - /* avoid dangling else. */ - Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50); - } - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - FromImport := 'FROM' Ident 'IMPORT' IdentList ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - ImportModuleList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ImportModuleList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_fromtok) - { - FromImport (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_importtok) - { - /* avoid dangling else. */ - WithoutFromImport (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29); - } -} - - -/* - DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR' - string ] - Ident ';' - % curmodule := lookupDef (curident) % - - % enterScope (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % leaveScope % - - % setEnumsComplete (curmodule) % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_fortok) - { - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - curmodule = decl_lookupDef (curident); - decl_enterScope (curmodule); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Definition (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "definition module", 17); - decl_leaveScope (); - decl_setEnumsComplete (curmodule); -} - - -/* - DefQualident := Ident - % typeExp := lookupSym (curident) % - [ '.' - % IF NOT isDef (typeExp) - THEN - ErrorArray ('the first component of this qualident must be a definition module') - END % - Ident - % typeExp := lookupInScope (typeExp, curident) ; - IF typeExp=NIL - THEN - ErrorArray ('identifier not found in definition module') - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void DefQualident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - typeExp = decl_lookupSym (curident); - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (! (decl_isDef (typeExp))) - { - ErrorArray ((const char *) "the first component of this qualident must be a definition module", 65); - } - Ident (stopset0, stopset1, stopset2); - typeExp = decl_lookupInScope (typeExp, curident); - if (typeExp == NULL) - { - ErrorArray ((const char *) "identifier not found in definition module", 41); - } - } -} - - -/* - DefOptSubrange := [ SubrangeType | - - % putType (typeDes, typeExp) % - ] - - first symbols:lsbratok - - reachend -*/ - -static void DefOptSubrange (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - SubrangeType (stopset0, stopset1, stopset2); - } - else - { - decl_putType (typeDes, typeExp); - } - } - /* end of optional [ | ] expression */ -} - - -/* - DefTypeEquiv := DefQualident DefOptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void DefTypeEquiv (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - DefQualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - DefOptSubrange (stopset0, stopset1, stopset2); -} - - -/* - DefEnumIdentList := - % VAR n, f: node ; % - - % n := makeEnum () % - Ident - % f := makeEnumField (n, curident) % - { ',' Ident - % f := makeEnumField (n, curident) % - } - % IF typeDes # NIL THEN putType (typeDes, n) END % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefEnumIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - decl_node n; - decl_node f; - - n = decl_makeEnum (); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - f = decl_makeEnumField (n, curident); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - f = decl_makeEnumField (n, curident); - } - /* while */ - if (typeDes != NULL) - { - decl_putType (typeDes, n); - } -} - - -/* - DefEnumeration := '(' DefEnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void DefEnumeration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefEnumIdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - DefSimpleType := DefTypeEquiv | DefEnumeration | - SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void DefSimpleType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - DefTypeEquiv (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - DefEnumeration (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - SubrangeType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: [ ( identifier", 32); - } -} - - -/* - DefType := DefSimpleType | ArrayType | - RecordType | SetType | PointerType | - ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void DefType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - DefSimpleType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_arraytok) - { - /* avoid dangling else. */ - ArrayType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_recordtok) - { - /* avoid dangling else. */ - RecordType (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok)) - { - /* avoid dangling else. */ - SetType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_pointertok) - { - /* avoid dangling else. */ - PointerType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80); - } -} - - -/* - DefTypeDeclaration := { Ident - % typeDes := lookupSym (curident) % - ( ';' | '=' DefType Alignment - ';' ) } - - first symbols:identtok - - reachend -*/ - -static void DefTypeDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - typeDes = decl_lookupSym (curident); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: = ;", 21); - } - } - /* while */ -} - - -/* - DefConstantDeclaration := Ident '=' ConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void DefConstantDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); -} - - -/* - Definition := 'CONST' { DefConstantDeclaration ';' } | - 'TYPE' { DefTypeDeclaration } | - 'VAR' { DefVariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - DefConstantDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - DefTypeDeclaration (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - DefVariableDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - DefProcedureHeading (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42); - } -} - - -/* - AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_asmtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_volatiletok) - { - Expect (mcReserved_volatiletok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmOperands (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - string (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - AsmOperandSpec (stopset0, stopset1, stopset2); - } -} - - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - TrashList (stopset0, stopset1, stopset2); - } - } - } -} - - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok)) - { - AsmElement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmElement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - NamedOperand (stopset0, stopset1, stopset2); - } -} - - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - AsmOperandName (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - string (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp2_CompilationUnit (void) -{ - WasNoError = TRUE; - FileUnit ((mcp2_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp2_SetOfStop1) 0, (mcp2_SetOfStop2) 0); - return WasNoError; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcp2_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcp2_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gmcp3.c b/gcc/m2/mc-boot/Gmcp3.c deleted file mode 100644 index 4ff8d80307ab..000000000000 --- a/gcc/m2/mc-boot/Gmcp3.c +++ /dev/null @@ -1,7854 +0,0 @@ -/* do not edit automatically generated by mc from mcp3. */ -/* output from mc-3.bnf, automatically generated do not edit. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING. If not, -see . */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcp3_H -#define _mcp3_C - -# include "GDynamicStrings.h" -# include "GmcError.h" -# include "GnameKey.h" -# include "GmcPrintf.h" -# include "GmcDebug.h" -# include "GmcReserved.h" -# include "GmcMetaError.h" -# include "GmcStack.h" -# include "GmcLexBuf.h" -# include "Gdecl.h" - -# define Pass1 FALSE -# define Debugging FALSE -typedef unsigned int mcp3_stop0; - -typedef unsigned int mcp3_SetOfStop0; - -typedef unsigned int mcp3_stop1; - -typedef unsigned int mcp3_SetOfStop1; - -typedef unsigned int mcp3_stop2; - -typedef unsigned int mcp3_SetOfStop2; - -static unsigned int WasNoError; -static unsigned int curisused; -static nameKey_Name curstring; -static nameKey_Name curident; -static decl_node curproc; -static decl_node frommodule; -static decl_node typeDes; -static decl_node typeExp; -static decl_node curmodule; -static mcStack_stack stk; - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp3_CompilationUnit (void); - -/* - push - -*/ - -static decl_node push (decl_node n); - -/* - pop - -*/ - -static decl_node pop (void); - -/* - replace - -*/ - -static decl_node replace (decl_node n); - -/* - peep - returns the top node on the stack without removing it. -*/ - -static decl_node peep (void); - -/* - depth - returns the depth of the stack. -*/ - -static unsigned int depth (void); - -/* - checkDuplicate - -*/ - -static void checkDuplicate (unsigned int b); - -/* - checkDuplicate - -*/ - -static void ErrorString (DynamicStrings_String s); - -/* - checkDuplicate - -*/ - -static void ErrorArray (const char *a_, unsigned int _a_high); - -/* - checkParameterAttribute - -*/ - -static void checkParameterAttribute (void); - -/* - checkReturnAttribute - -*/ - -static void checkReturnAttribute (void); - -/* - pushNunbounded - -*/ - -static void pushNunbounded (unsigned int c); - -/* - makeIndexedArray - builds and returns an array of type, t, with, c, indices. -*/ - -static decl_node makeIndexedArray (unsigned int c, decl_node t); - -/* - importInto - from, m, import, name, into module, current. - It checks to see if curident is an enumeration type - and if so automatically includes all enumeration fields - as well. -*/ - -static void importInto (decl_node m, nameKey_Name name, decl_node current); - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high); - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void); - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t); - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t); - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - string - -*/ - -static void string (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Integer - -*/ - -static void Integer (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Real - -*/ - -static void Real (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % enterScope (curmodule) % - - % resetEnumPos (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % setConstExpComplete (curmodule) % - - % leaveScope % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - - % resetEnumPos (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % setConstExpComplete (curmodule) % - - % leaveScope ; leaveScope % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstantDeclaration := - % VAR d, e: node ; % - Ident - % d := lookupSym (curident) % - '=' ConstExpression - % e := pop () % - - % assert (isConst (d)) % - - % putConst (d, e) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstExpressionNop := SimpleConstExpr - % VAR n: node ; % - [ Relation SimpleConstExpr ] - - % n := makeConstExp () % - - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpressionNop (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstExpression := - % VAR n: node ; % - - % n := push (makeConstExp ()) % - SimpleConstExpr [ Relation SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SimpleConstExpr := UnaryOrConstTerm { AddOperator - ConstTerm } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - UnaryOrConstTerm := '+' ConstTerm | - '-' ConstTerm | - ConstTerm - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstTerm := ConstFactor { MulOperator ConstFactor } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstFactor := Number | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpressionNop ')' | - 'NOT' ConstFactor | - ConstAttribute - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ComponentElement := ConstExpressionNop [ '..' ConstExpressionNop ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ComponentValue := ComponentElement [ 'BY' ConstExpressionNop ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Constructor := '{' [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstSetOrQualidentOrFunction := Qualident [ Constructor | - ConstActualParameters ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstActualParameters := '(' [ ConstExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstExpList := ConstExpressionNop { ',' ConstExpressionNop } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ConstAttributeExpression := Ident | '<' Qualident - ',' Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AlignmentExpression := '(' ConstExpressionNop ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - PushIdentList := - % VAR n: node ; % - - % n := makeIdentList () % - Ident - % checkDuplicate (putIdent (n, curident)) % - { ',' Ident - % checkDuplicate (putIdent (n, curident)) % - } - % n := push (n) % - - - first symbols:identtok - - cannot reachend -*/ - -static void PushIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SubrangeType := - % VAR low, high: node ; d: CARDINAL ; % - '[' - % d := depth () % - ConstExpression - % low := pop () % - - % assert (d = depth ()) % - '..' ConstExpression - % high := pop () % - - % assert (d = depth ()) % - - % typeExp := push (makeSubrange (low, high)) % - - % assert (d = depth () - 1) % - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ArrayType := 'ARRAY' - % VAR c: CARDINAL ; t, n: node ; % - - % c := 0 % - SimpleType - % INC (c) % - { ',' SimpleType - % INC (c) % - } 'OF' Type - % n := push (makeIndexedArray (c, pop ())) % - - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - RecordType := 'RECORD' - % VAR n: node ; % - - % n := push (makeRecord ()) % - - % n := push (NIL) no varient % - [ DefaultRecordAttributes ] FieldListSequence - - % assert (pop ()=NIL) % - 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - PragmaConstExpression := [ '(' ConstExpressionNop - ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AttributeExpression := Ident '(' ConstExpressionNop - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FieldList := - % VAR r, i, f, t, n, v, w: node ; d: CARDINAL ; % - - % d := depth () % - - % v := pop () ; assert ((v=NIL) OR isVarient (v)) % - - % r := peep () ; assert (isRecord (r) OR isVarientField (r)) % - - % v := push (v) % - - % assert (d=depth ()) % - - % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isVarientField (r))) % - PushIdentList ':' - % assert (d=depth () - 1) % - - % i := pop () % - Type - % assert (d=depth () - 1) % - - % t := pop () % - RecordFieldPragma - % assert (d=depth ()) % - - % r := addFieldsToRecord (r, v, i, t) % - - % assert (d=depth ()) % - | - 'CASE' - % addRecordToList % - - % d := depth () % - - % v := pop () ; assert ((v=NIL) OR isVarient (v)) % - - % r := peep () ; assert (isRecord (r) OR isVarientField (r)) % - - % v := push (v) % - - % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isRecordField (r))) % - - % w := push (makeVarient (r)) % - - % assert (d = depth () - 1) % - - % addVarientToList % - CaseTag 'OF' - % assert (d = depth () - 1) % - Varient - % assert (d = depth () - 1) % - { '|' Varient - % assert (d = depth () - 1) % - } - % w := peep () ; assert (isVarient (w)) % - - % assert (d = depth () - 1) % - [ 'ELSE' FieldListSequence ] 'END' - - % w := pop () ; assert (isVarient (w)) % - - % assert (d=depth ()) % - - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - TagIdent := Ident | - % curident := NulName % - - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - CaseTag := - % VAR tagident: Name ; q, v, w, r: node ; % - - % w := pop () ; v := pop () ; r := peep () ; v := push (v) ; w := push (w) % - - % assert (isVarient (w)) % - - % assert ((v=NIL) OR isVarient (v)) % - - % assert (isRecord (r) OR isVarientField (r)) % - - % assert (isVarient (push (pop ()))) % - TagIdent - % tagident := curident % - ( ':' PushQualident - % q := pop () % - - % assert (isVarient (push (pop ()))) % - | - % q := NIL % - ) - % buildVarientSelector (r, w, tagident, q) % - - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Varient := - % VAR p, r, v, f: node ; d: CARDINAL ; % - - % d := depth () % - - % assert (isVarient (peep ())) % - [ - % v := pop () ; assert (isVarient (v)) % - - % r := pop () % - - % p := peep () % - - % r := push (r) % - - % f := push (buildVarientFieldRecord (v, p)) % - - % v := push (v) % - VarientCaseLabelList ':' FieldListSequence - - % v := pop () % - - % f := pop () % - - % assert (isVarientField (f)) % - - % assert (isVarient (v)) % - - % v := push (v) % - ] - % assert (isVarient (peep ())) % - - % assert (d=depth ()) % - - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - VarientCaseLabels := - % VAR l, h: node ; % - - % h := NIL % - ConstExpression - % l := pop () % - [ '..' ConstExpression - % h := pop () % - ] - % l, h could be saved if necessary. % - - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - % VAR n: node ; % - - % n := push (makeSet (pop ())) % - - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - PointerType := 'POINTER' 'TO' Type - % VAR n: node ; % - - % n := push (makePointer (pop ())) % - - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProcedureType := 'PROCEDURE' - % curproc := push (makeProcType ()) % - [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - OptReturnType := '[' PushQualident - % putReturnType (curproc, pop ()) % - - % putOptReturn (curproc) % - ']' | PushQualident - % putReturnType (curproc, pop ()) % - - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProcedureParameters := ProcedureParameter - % addParameter (curproc, pop ()) % - { ',' ProcedureParameter - - % addParameter (curproc, pop ()) % - } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProcedureParameter := '...' - % VAR n: node ; % - - % n := push (makeVarargs ()) % - | 'VAR' FormalType - % n := push (makeVarParameter (NIL, pop (), curproc, TRUE)) % - | FormalType - % n := push (makeNonVarParameter (NIL, pop (), curproc, TRUE)) % - - - first symbols:identtok, arraytok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - VarIdent := - % VAR n, a: node ; % - - % n := pop () % - Ident - % checkDuplicate (putIdent (n, curident)) % - - % n := push (n) % - [ '[' ConstExpression - % a := pop () could store, a, into, n. % - ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - VarIdentList := - % VAR n: node ; % - - % n := makeIdentList () % - - % n := push (n) % - VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - VariableDeclaration := - % VAR v, d: node ; % - VarIdentList - % v := pop () % - ':' Type - % d := makeVarDecl (v, pop ()) % - Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Designator := Qualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SubDesignator := '.' Ident | '[' ArrayExpList ']' | - '^' - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ArrayExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Expression := SimpleExpression [ Relation SimpleExpression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SimpleExpression := UnaryOrTerm { AddOperator Term } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - UnaryOrTerm := '+' Term | '-' Term | - Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Term := Factor { MulOperator Factor } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Factor := Number | string | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor | ConstAttribute ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SetOrDesignatorOrFunction := Qualident [ Constructor | - SimpleDes - [ ActualParameters ] ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SimpleDes := { SubDesignator } - - first symbols:periodtok, lsbratok, uparrowtok - - reachend -*/ - -static void SimpleDes (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ActualParameters := '(' [ ExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ExitStatement := 'EXIT' - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ReturnStatement := 'RETURN' [ Expression ] - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Statement := [ AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement ] - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok - - reachend -*/ - -static void Statement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - RetryStatement := 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AssignmentOrProcedureCall := Designator ( ':=' Expression | - ActualParameters | - - % epsilon % - ) - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - StatementSequence := Statement { ';' Statement } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - IfStatement := 'IF' Expression 'THEN' StatementSequence - { 'ELSIF' Expression 'THEN' StatementSequence } - [ 'ELSE' StatementSequence ] 'END' - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - CaseStatement := 'CASE' Expression 'OF' Case { '|' - Case } - CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - CaseEndStatement := 'END' | 'ELSE' StatementSequence - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Case := [ CaseLabelList ':' StatementSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - CaseLabelList := CaseLabels { ',' CaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - CaseLabels := ConstExpressionNop [ '..' ConstExpressionNop ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - WhileStatement := 'WHILE' Expression 'DO' StatementSequence - 'END' - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - RepeatStatement := 'REPEAT' StatementSequence 'UNTIL' - Expression - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ForStatement := 'FOR' Ident ':=' Expression 'TO' - Expression [ 'BY' ConstExpressionNop ] - 'DO' StatementSequence 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - LoopStatement := 'LOOP' StatementSequence 'END' - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - WithStatement := 'WITH' Designator 'DO' StatementSequence - 'END' - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - % leaveScope % - - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) % - - % enterScope (curproc) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefProcedureIdent := Ident - % curproc := lookupSym (curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefProcedureIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent [ FormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - NormalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ExceptionalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefFormalParameters := '(' - % paramEnter (curproc) % - [ DefMultiFPSection ] ')' - - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FormalParameters := '(' - % paramEnter (curproc) % - [ MultiFPSection ] ')' - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AttributeNoReturn := [ NoReturn | - % setNoReturn (curproc, FALSE) % - ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - NoReturn := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void NoReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AttributeUnused := [ Unused ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Unused := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void Unused (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefExtendedFP := DefOptArg | '...' - % addParameter (curproc, makeVarargs ()) % - - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - VarFPSection := 'VAR' PushIdentList - % VAR l, t: node ; % - ':' FormalType - % t := pop () % - - % l := pop () % - - % curisused := TRUE % - [ AttributeUnused ] - % addVarParameters (curproc, l, t, curisused) % - - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - NonVarFPSection := PushIdentList - % VAR l, t: node ; % - ':' FormalType - % t := pop () % - - % l := pop () % - - % curisused := TRUE % - [ AttributeUnused ] - % addNonVarParameters (curproc, l, t, curisused) % - - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - OptArg := - % VAR p, init, type: node ; id: Name ; % - '[' Ident - % id := curident % - ':' FormalType - % type := pop () % - - % init := NIL % - [ '=' ConstExpression - % init := pop () % - ] ']' - % p := addOptParameter (curproc, id, type, init) % - - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefOptArg := - % VAR p, init, type: node ; id: Name ; % - '[' Ident - % id := curident % - ':' FormalType - % type := pop () % - '=' ConstExpression - % init := pop () % - ']' - % p := addOptParameter (curproc, id, type, init) % - - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FormalType := - % VAR c: CARDINAL ; % - - % VAR n, a, s: node ; % - - % c := 0 % - { 'ARRAY' 'OF' - % INC (c) % - } PushQualident - % pushNunbounded (c) % - - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Priority := '[' ConstExpressionNop ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FromIdentList := Ident - % importInto (frommodule, curident, curmodule) % - { ',' Ident - % importInto (frommodule, curident, curmodule) % - } - - first symbols:identtok - - cannot reachend -*/ - -static void FromIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - FromImport := 'FROM' Ident - % frommodule := lookupDef (curident) % - 'IMPORT' FromIdentList ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - ImportModuleList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR' - string ] - Ident ';' - % curmodule := lookupDef (curident) % - - % enterScope (curmodule) % - - % resetEnumPos (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % setConstExpComplete (curmodule) % - - % leaveScope % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - PushQualident := Ident - % typeExp := push (lookupSym (curident)) % - - % IF typeExp = NIL - THEN - metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident) - END % - [ '.' - % IF NOT isDef (typeExp) - THEN - ErrorArray ('the first component of this qualident must be a definition module') - END % - Ident - % typeExp := replace (lookupInScope (typeExp, curident)) ; - IF typeExp=NIL - THEN - ErrorArray ('identifier not found in definition module') - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void PushQualident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - OptSubrange := [ SubrangeType - % VAR q, s: node ; % - - % s := pop () % - - % q := pop () % - - % putSubrangeType (s, q) % - - % typeExp := push (s) % - ] - - first symbols:lsbratok - - reachend -*/ - -static void OptSubrange (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - TypeEquiv := PushQualident OptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void TypeEquiv (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - EnumIdentList := - % VAR f: node ; % - - % typeExp := push (makeEnum ()) % - Ident - % f := makeEnumField (typeExp, curident) % - { ',' Ident - % f := makeEnumField (typeExp, curident) % - } - - first symbols:identtok - - cannot reachend -*/ - -static void EnumIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Enumeration := '(' EnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - SimpleType := - % VAR d: CARDINAL ; % - - % d := depth () % - ( TypeEquiv | Enumeration | - SubrangeType ) - % assert (d = depth () - 1) % - - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Type := SimpleType | ArrayType | RecordType | - SetType | PointerType | ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void Type (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - TypeDeclaration := { Ident - % typeDes := lookupSym (curident) % - ( ';' | '=' Type - % putType (typeDes, pop ()) % - Alignment ';' ) } - - first symbols:identtok - - reachend -*/ - -static void TypeDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - Definition := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2); - - -/* - push - -*/ - -static decl_node push (decl_node n) -{ - return static_cast (mcStack_push (stk, reinterpret_cast (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - pop - -*/ - -static decl_node pop (void) -{ - return static_cast (mcStack_pop (stk)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - replace - -*/ - -static decl_node replace (decl_node n) -{ - return static_cast (mcStack_replace (stk, reinterpret_cast (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - peep - returns the top node on the stack without removing it. -*/ - -static decl_node peep (void) -{ - return push (pop ()); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - depth - returns the depth of the stack. -*/ - -static unsigned int depth (void) -{ - return mcStack_depth (stk); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkDuplicate - -*/ - -static void checkDuplicate (unsigned int b) -{ -} - - -/* - checkDuplicate - -*/ - -static void ErrorString (DynamicStrings_String s) -{ - mcError_errorStringAt (s, mcLexBuf_getTokenNo ()); - WasNoError = FALSE; -} - - -/* - checkDuplicate - -*/ - -static void ErrorArray (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - ErrorString (DynamicStrings_InitString ((const char *) a, _a_high)); -} - - -/* - checkParameterAttribute - -*/ - -static void checkParameterAttribute (void) -{ - if ((nameKey_makeKey ((const char *) "unused", 6)) != curident) - { - mcMetaError_metaError1 ((const char *) "attribute {%1k} is not allowed in the formal parameter section, currently only unused is allowed", 96, (const unsigned char *) &curident, (sizeof (curident)-1)); - } -} - - -/* - checkReturnAttribute - -*/ - -static void checkReturnAttribute (void) -{ - if ((nameKey_makeKey ((const char *) "noreturn", 8)) != curident) - { - mcMetaError_metaError1 ((const char *) "attribute {%1k} is not allowed in the procedure return type, only noreturn is allowed", 85, (const unsigned char *) &curident, (sizeof (curident)-1)); - } -} - - -/* - pushNunbounded - -*/ - -static void pushNunbounded (unsigned int c) -{ - decl_node type; - decl_node array; - decl_node subrange; - - while (c != 0) - { - type = pop (); - subrange = decl_makeSubrange (static_cast (NULL), static_cast (NULL)); - decl_putSubrangeType (subrange, decl_getCardinal ()); - array = decl_makeArray (subrange, type); - decl_putUnbounded (array); - type = push (array); - c -= 1; - } -} - - -/* - makeIndexedArray - builds and returns an array of type, t, with, c, indices. -*/ - -static decl_node makeIndexedArray (unsigned int c, decl_node t) -{ - decl_node i; - - while (c > 0) - { - t = decl_makeArray (pop (), t); - c -= 1; - } - return t; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - importInto - from, m, import, name, into module, current. - It checks to see if curident is an enumeration type - and if so automatically includes all enumeration fields - as well. -*/ - -static void importInto (decl_node m, nameKey_Name name, decl_node current) -{ - decl_node s; - decl_node o; - - mcDebug_assert (decl_isDef (m)); - mcDebug_assert (((decl_isDef (current)) || (decl_isModule (current))) || (decl_isImp (current))); - s = decl_lookupExported (m, name); - if (s == NULL) - { - mcMetaError_metaError2 ((const char *) "{%1k} was not exported from definition module {%2a}", 51, (const unsigned char *) &name, (sizeof (name)-1), (const unsigned char *) &m, (sizeof (m)-1)); - } - else - { - o = decl_import (current, s); - if (s != o) - { - mcMetaError_metaError2 ((const char *) "{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}", 87, (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &o, (sizeof (o)-1)); - } - } -} - - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high) -{ - DynamicStrings_String s; - char desc[_desc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (desc, desc_, _desc_high+1); - - if ((decl_getSymName (module)) != name) - { - s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41); - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high))); - ErrorString (s); - } -} - - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - unsigned int n; - DynamicStrings_String str; - DynamicStrings_String message; - - n = 0; - message = DynamicStrings_InitString ((const char *) "", 0); - if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6))); - n += 1; - } - if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11))); - n += 1; - } - if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10))); - n += 1; - } - if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14))); - n += 1; - } - if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10))); - n += 1; - } - if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11))); - n += 1; - } - if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13))); - n += 1; - } - if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3))); - n += 1; - } - if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8))); - n += 1; - } - if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3))); - n += 1; - } - if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4))); - n += 1; - } - if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5))); - n += 1; - } - if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3))); - n += 1; - } - if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5))); - n += 1; - } - if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4))); - n += 1; - } - if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2))); - n += 1; - } - if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4))); - n += 1; - } - if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3))); - n += 1; - } - if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6))); - n += 1; - } - if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5))); - n += 1; - } - if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6))); - n += 1; - } - if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3))); - n += 1; - } - if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6))); - n += 1; - } - if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11))); - n += 1; - } - if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9))); - n += 1; - } - if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9))); - n += 1; - } - if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7))); - n += 1; - } - if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9))); - n += 1; - } - if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2))); - n += 1; - } - if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2))); - n += 1; - } - if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3))); - n += 1; - } - if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6))); - n += 1; - } - if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3))); - n += 1; - } - if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4))); - n += 1; - } - if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2))); - n += 1; - } - if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14))); - n += 1; - } - if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2))); - n += 1; - } - if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4))); - n += 1; - } - if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3))); - n += 1; - } - if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7))); - n += 1; - } - if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4))); - n += 1; - } - if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6))); - n += 1; - } - if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3))); - n += 1; - } - if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5))); - n += 1; - } - if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4))); - n += 1; - } - if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2))); - n += 1; - } - if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3))); - n += 1; - } - if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10))); - n += 1; - } - if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5))); - n += 1; - } - if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4))); - n += 1; - } - if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2))); - n += 1; - } - if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5))); - n += 1; - } - if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5))); - n += 1; - } - if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3))); - n += 1; - } - if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2))); - n += 1; - } - if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2))); - n += 1; - } - if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2))); - n += 1; - } - if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2))); - n += 1; - } - if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1))); - n += 1; - } - if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1))); - n += 1; - } - if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1))); - n += 1; - } - if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1))); - n += 1; - } - if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))); - n += 1; - } - if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1))); - n += 1; - } - if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1))); - n += 1; - } - if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1))); - n += 1; - } - if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1))); - n += 1; - } - if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1))); - n += 1; - } - if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ','); - n += 1; - } - if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ','); - n += 1; - } - if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1))); - n += 1; - } - if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1))); - n += 1; - } - if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1))); - n += 1; - } - if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1))); - n += 1; - } - if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1))); - n += 1; - } - if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1))); - n += 1; - } - if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1))); - n += 1; - } - if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1))); - n += 1; - } - if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1))); - n += 1; - } - if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2))); - n += 1; - } - if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0)) - {} /* empty. */ - /* eoftok has no token name (needed to generate error messages) */ - if (n == 0) - { - str = DynamicStrings_InitString ((const char *) " syntax error", 13); - message = DynamicStrings_KillString (message); - } - else if (n == 1) - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9))); - } - else - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message); - message = DynamicStrings_KillString (message); - } - return str; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void) -{ - DynamicStrings_String str; - - str = DynamicStrings_InitString ((const char *) "", 0); - switch (mcLexBuf_currenttoken) - { - case mcReserved_stringtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_realtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_identtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_integertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_inlinetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_builtintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_attributetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str)); - break; - - case mcReserved_filetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_linetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_datetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_volatiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_asmtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_withtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_whiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_vartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_untiltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_typetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_totok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_thentok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_settok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_returntok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_retrytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_repeattok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_remtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_recordtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_unqualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_qualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_proceduretok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_pointertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_packedsettok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_ortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_oftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_nottok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_moduletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_modtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_looptok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_intok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_importtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_implementationtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_iftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_fromtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_fortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_finallytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_exporttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_exittok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_excepttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_endtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsiftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_dotok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_divtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_definitiontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_consttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_casetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_bytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_begintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_arraytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_andtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_colontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_rdirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_ldirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_greaterequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessgreatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_hashtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_equaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_uparrowtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_semicolontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_commatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_ambersandtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_dividetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_timestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_minustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_plustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_doublequotestok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str)); - break; - - case mcReserved_singlequotetok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str)); - break; - - case mcReserved_greatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lesstok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_bartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_becomestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_eoftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str)); - break; - - - default: - break; - } - ErrorString (str); -} - - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - DescribeError (); - if (Debugging) - { - mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21); - } - /* - yes the ORD(currenttoken) looks ugly, but it is *much* safer than - using currenttoken= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - mcLexBuf_getToken (); - } - if (Debugging) - { - mcPrintf_printf0 ((const char *) " ***\\n", 6); - } -} - - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - SyntaxError (stopset0, stopset1, stopset2); - } -} - - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t) -{ - mcp3_SetOfStop0 s0; - mcp3_SetOfStop1 s1; - mcp3_SetOfStop2 s2; - DynamicStrings_String str; - - s0 = (mcp3_SetOfStop0) 0; - s1 = (mcp3_SetOfStop1) 0; - s2 = (mcp3_SetOfStop2) 0; - if ( ((unsigned int) (t)) < 32) - { - s0 = (mcp3_SetOfStop0) ((1 << (t-mcReserved_eoftok))); - } - else if ( ((unsigned int) (t)) < 64) - { - /* avoid dangling else. */ - s1 = (mcp3_SetOfStop1) ((1 << (t-mcReserved_arraytok))); - } - else - { - /* avoid dangling else. */ - s2 = (mcp3_SetOfStop2) ((1 << (t-mcReserved_recordtok))); - } - str = DescribeStop (s0, s1, s2); - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str)); - mcError_errorStringAt (str, mcLexBuf_getTokenNo ()); -} - - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t) -{ - WarnMissingToken (t); - if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok)) - { - if (Debugging) - { - mcPrintf_printf0 ((const char *) "inserting token\\n", 17); - } - mcLexBuf_insertToken (t); - } -} - - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - WarnMissingToken (t); - mcLexBuf_insertTokenAndRewind (t); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2)))) - { - /* SyntaxCheck would fail since currentoken is not part of the stopset - we check to see whether any of currenttoken might be a commonly omitted token */ - if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2))) - {} /* empty. */ - } -} - - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == t) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (Pass1) - { - PeepToken (stopset0, stopset1, stopset2); - } - } - else - { - MissingToken (t); - } - SyntaxCheck (stopset0, stopset1, stopset2); -} - - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - curident = nameKey_makekey (mcLexBuf_currentstring); - Expect (mcReserved_identtok, stopset0, stopset1, stopset2); -} - - -/* - string - -*/ - -static void string (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - curstring = nameKey_makekey (mcLexBuf_currentstring); - Expect (mcReserved_stringtok, stopset0, stopset1, stopset2); -} - - -/* - Integer - -*/ - -static void Integer (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_integertok, stopset0, stopset1, stopset2); -} - - -/* - Real - -*/ - -static void Real (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_realtok, stopset0, stopset1, stopset2); -} - - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_definitiontok) - { - DefinitionModule (stopset0, stopset1, stopset2); - } - else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) - { - /* avoid dangling else. */ - ImplementationOrProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50); - } -} - - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % enterScope (curmodule) % - - % resetEnumPos (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % setConstExpComplete (curmodule) % - - % leaveScope % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupModule (curident); - decl_enterScope (curmodule); - decl_resetEnumPos (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "program module", 14); - decl_setConstExpComplete (curmodule); - decl_leaveScope (); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - - % resetEnumPos (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % setConstExpComplete (curmodule) % - - % leaveScope ; leaveScope % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupImp (curident); - decl_enterScope (decl_lookupDef (curident)); - decl_enterScope (curmodule); - decl_resetEnumPos (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "implementation module", 21); - decl_setConstExpComplete (curmodule); - decl_leaveScope (); - decl_leaveScope (); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_implementationtok) - { - ImplementationModule (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39); - } -} - - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_integertok) - { - Integer (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_realtok) - { - /* avoid dangling else. */ - Real (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: real number integer number", 44); - } -} - - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstantDeclaration := - % VAR d, e: node ; % - Ident - % d := lookupSym (curident) % - '=' ConstExpression - % e := pop () % - - % assert (isConst (d)) % - - % putConst (d, e) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node d; - decl_node e; - - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - d = decl_lookupSym (curident); - Expect (mcReserved_equaltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - e = pop (); - mcDebug_assert (decl_isConst (d)); - decl_putConst (d, e); -} - - -/* - ConstExpressionNop := SimpleConstExpr - % VAR n: node ; % - [ Relation SimpleConstExpr ] - - % n := makeConstExp () % - - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpressionNop (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - - SimpleConstExpr (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SimpleConstExpr (stopset0, stopset1, stopset2); - } - n = decl_makeConstExp (); -} - - -/* - ConstExpression := - % VAR n: node ; % - - % n := push (makeConstExp ()) % - SimpleConstExpr [ Relation SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - - n = push (decl_makeConstExp ()); - SimpleConstExpr (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SimpleConstExpr (stopset0, stopset1, stopset2); - } -} - - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_hashtok) - { - /* avoid dangling else. */ - Expect (mcReserved_hashtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_intok) - { - /* avoid dangling else. */ - Expect (mcReserved_intok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37); - } -} - - -/* - SimpleConstExpr := UnaryOrConstTerm { AddOperator - ConstTerm } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - UnaryOrConstTerm (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - AddOperator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - UnaryOrConstTerm := '+' ConstTerm | - '-' ConstTerm | - ConstTerm - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ConstTerm (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ identifier { string - +", 88); - } -} - - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ortok) - { - /* avoid dangling else. */ - Expect (mcReserved_ortok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: OR - +", 24); - } -} - - -/* - ConstTerm := ConstFactor { MulOperator ConstFactor } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - ConstFactor (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - MulOperator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstFactor (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_timestok) - { - Expect (mcReserved_timestok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_dividetok) - { - /* avoid dangling else. */ - Expect (mcReserved_dividetok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_divtok) - { - /* avoid dangling else. */ - Expect (mcReserved_divtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_modtok) - { - /* avoid dangling else. */ - Expect (mcReserved_modtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_remtok) - { - /* avoid dangling else. */ - Expect (mcReserved_remtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_andtok) - { - /* avoid dangling else. */ - Expect (mcReserved_andtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ambersandtok) - { - /* avoid dangling else. */ - Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39); - } -} - - -/* - ConstFactor := Number | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpressionNop ')' | - 'NOT' ConstFactor | - ConstAttribute - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - ConstString (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstFactor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( identifier { string integer number real number", 84); - } -} - - -/* - ConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - string (stopset0, stopset1, stopset2); -} - - -/* - ComponentElement := ConstExpressionNop [ '..' ConstExpressionNop ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0, stopset1, stopset2); - } -} - - -/* - ComponentValue := ComponentElement [ 'BY' ConstExpressionNop ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - ComponentElement (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0, stopset1, stopset2); - } -} - - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - ComponentValue (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ComponentValue (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Constructor := '{' [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lcbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - ArraySetRecordValue (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - ConstSetOrQualidentOrFunction := Qualident [ Constructor | - ConstActualParameters ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - Constructor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ConstActualParameters (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( {", 21); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - Constructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - ConstActualParameters := '(' [ ConstExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - ConstExpList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ConstExpList := ConstExpressionNop { ',' ConstExpressionNop } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstAttributeExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ConstAttributeExpression := Ident | '<' Qualident - ',' Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: < identifier", 30); - } -} - - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - AlignmentExpression (stopset0, stopset1, stopset2); - } -} - - -/* - AlignmentExpression := '(' ConstExpressionNop ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - ByteAlignment (stopset0, stopset1, stopset2); - } -} - - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - PushIdentList := - % VAR n: node ; % - - % n := makeIdentList () % - Ident - % checkDuplicate (putIdent (n, curident)) % - { ',' Ident - % checkDuplicate (putIdent (n, curident)) % - } - % n := push (n) % - - - first symbols:identtok - - cannot reachend -*/ - -static void PushIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - - n = decl_makeIdentList (); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - checkDuplicate (decl_putIdent (n, curident)); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - checkDuplicate (decl_putIdent (n, curident)); - } - /* while */ - n = push (n); -} - - -/* - SubrangeType := - % VAR low, high: node ; d: CARDINAL ; % - '[' - % d := depth () % - ConstExpression - % low := pop () % - - % assert (d = depth ()) % - '..' ConstExpression - % high := pop () % - - % assert (d = depth ()) % - - % typeExp := push (makeSubrange (low, high)) % - - % assert (d = depth () - 1) % - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node low; - decl_node high; - unsigned int d; - - Expect (mcReserved_lsbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - d = depth (); - ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - low = pop (); - mcDebug_assert (d == (depth ())); - Expect (mcReserved_periodperiodtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - high = pop (); - mcDebug_assert (d == (depth ())); - typeExp = push (decl_makeSubrange (low, high)); - mcDebug_assert (d == ((depth ())-1)); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - ArrayType := 'ARRAY' - % VAR c: CARDINAL ; t, n: node ; % - - % c := 0 % - SimpleType - % INC (c) % - { ',' SimpleType - % INC (c) % - } 'OF' Type - % n := push (makeIndexedArray (c, pop ())) % - - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - unsigned int c; - decl_node t; - decl_node n; - - Expect (mcReserved_arraytok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - c = 0; - SimpleType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - c += 1; - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - c += 1; - } - /* while */ - Expect (mcReserved_oftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); - n = push (makeIndexedArray (c, pop ())); -} - - -/* - RecordType := 'RECORD' - % VAR n: node ; % - - % n := push (makeRecord ()) % - - % n := push (NIL) no varient % - [ DefaultRecordAttributes ] FieldListSequence - - % assert (pop ()=NIL) % - 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_recordtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - n = push (decl_makeRecord ()); - n = push (static_cast (NULL)); /* no varient */ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - DefaultRecordAttributes (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - FieldListSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - mcDebug_assert ((pop ()) == NULL); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - PragmaConstExpression (stopset0, stopset1, stopset2); -} - - -/* - PragmaConstExpression := [ '(' ConstExpressionNop - ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeExpression := Ident '(' ConstExpressionNop - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - FieldListStatement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListStatement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - FieldList (stopset0, stopset1, stopset2); - } -} - - -/* - FieldList := - % VAR r, i, f, t, n, v, w: node ; d: CARDINAL ; % - - % d := depth () % - - % v := pop () ; assert ((v=NIL) OR isVarient (v)) % - - % r := peep () ; assert (isRecord (r) OR isVarientField (r)) % - - % v := push (v) % - - % assert (d=depth ()) % - - % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isVarientField (r))) % - PushIdentList ':' - % assert (d=depth () - 1) % - - % i := pop () % - Type - % assert (d=depth () - 1) % - - % t := pop () % - RecordFieldPragma - % assert (d=depth ()) % - - % r := addFieldsToRecord (r, v, i, t) % - - % assert (d=depth ()) % - | - 'CASE' - % addRecordToList % - - % d := depth () % - - % v := pop () ; assert ((v=NIL) OR isVarient (v)) % - - % r := peep () ; assert (isRecord (r) OR isVarientField (r)) % - - % v := push (v) % - - % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isRecordField (r))) % - - % w := push (makeVarient (r)) % - - % assert (d = depth () - 1) % - - % addVarientToList % - CaseTag 'OF' - % assert (d = depth () - 1) % - Varient - % assert (d = depth () - 1) % - { '|' Varient - % assert (d = depth () - 1) % - } - % w := peep () ; assert (isVarient (w)) % - - % assert (d = depth () - 1) % - [ 'ELSE' FieldListSequence ] 'END' - - % w := pop () ; assert (isVarient (w)) % - - % assert (d=depth ()) % - - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node r; - decl_node i; - decl_node f; - decl_node t; - decl_node n; - decl_node v; - decl_node w; - unsigned int d; - - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - d = depth (); - v = pop (); - mcDebug_assert ((v == NULL) || (decl_isVarient (v))); - r = peep (); - mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r))); - v = push (v); - mcDebug_assert (d == (depth ())); - mcDebug_assert (((v == NULL) && (decl_isRecord (r))) || ((v != NULL) && (decl_isVarientField (r)))); - PushIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - mcDebug_assert (d == ((depth ())-1)); - i = pop (); - Type (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - mcDebug_assert (d == ((depth ())-1)); - t = pop (); - RecordFieldPragma (stopset0, stopset1, stopset2); - mcDebug_assert (d == (depth ())); - r = decl_addFieldsToRecord (r, v, i, t); - mcDebug_assert (d == (depth ())); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - Expect (mcReserved_casetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - /* addRecordToList */ - d = depth (); - v = pop (); - mcDebug_assert ((v == NULL) || (decl_isVarient (v))); - r = peep (); - mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r))); - v = push (v); - mcDebug_assert (((v == NULL) && (decl_isRecord (r))) || ((v != NULL) && (decl_isRecordField (r)))); - w = push (decl_makeVarient (r)); - mcDebug_assert (d == ((depth ())-1)); - /* addVarientToList */ - CaseTag (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - mcDebug_assert (d == ((depth ())-1)); - Varient (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - mcDebug_assert (d == ((depth ())-1)); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Varient (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - mcDebug_assert (d == ((depth ())-1)); - } - /* while */ - w = peep (); - mcDebug_assert (decl_isVarient (w)); - mcDebug_assert (d == ((depth ())-1)); - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - w = pop (); - mcDebug_assert (decl_isVarient (w)); - mcDebug_assert (d == (depth ())); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: CASE identifier", 33); - } -} - - -/* - TagIdent := Ident | - % curident := NulName % - - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else - { - curident = nameKey_NulName; - } -} - - -/* - CaseTag := - % VAR tagident: Name ; q, v, w, r: node ; % - - % w := pop () ; v := pop () ; r := peep () ; v := push (v) ; w := push (w) % - - % assert (isVarient (w)) % - - % assert ((v=NIL) OR isVarient (v)) % - - % assert (isRecord (r) OR isVarientField (r)) % - - % assert (isVarient (push (pop ()))) % - TagIdent - % tagident := curident % - ( ':' PushQualident - % q := pop () % - - % assert (isVarient (push (pop ()))) % - | - % q := NIL % - ) - % buildVarientSelector (r, w, tagident, q) % - - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - nameKey_Name tagident; - decl_node q; - decl_node v; - decl_node w; - decl_node r; - - w = pop (); - v = pop (); - r = peep (); - v = push (v); - w = push (w); - mcDebug_assert (decl_isVarient (w)); - mcDebug_assert ((v == NULL) || (decl_isVarient (v))); - mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r))); - mcDebug_assert (decl_isVarient (push (pop ()))); - TagIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - tagident = curident; - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - PushQualident (stopset0, stopset1, stopset2); - q = pop (); - mcDebug_assert (decl_isVarient (push (pop ()))); - } - else - { - q = static_cast (NULL); - } - decl_buildVarientSelector (r, w, tagident, q); -} - - -/* - Varient := - % VAR p, r, v, f: node ; d: CARDINAL ; % - - % d := depth () % - - % assert (isVarient (peep ())) % - [ - % v := pop () ; assert (isVarient (v)) % - - % r := pop () % - - % p := peep () % - - % r := push (r) % - - % f := push (buildVarientFieldRecord (v, p)) % - - % v := push (v) % - VarientCaseLabelList ':' FieldListSequence - - % v := pop () % - - % f := pop () % - - % assert (isVarientField (f)) % - - % assert (isVarient (v)) % - - % v := push (v) % - ] - % assert (isVarient (peep ())) % - - % assert (d=depth ()) % - - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node p; - decl_node r; - decl_node v; - decl_node f; - unsigned int d; - - d = depth (); - mcDebug_assert (decl_isVarient (peep ())); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))) - { - v = pop (); - mcDebug_assert (decl_isVarient (v)); - r = pop (); - p = peep (); - r = push (r); - f = push (decl_buildVarientFieldRecord (v, p)); - v = push (v); - VarientCaseLabelList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1, stopset2); - v = pop (); - f = pop (); - mcDebug_assert (decl_isVarientField (f)); - mcDebug_assert (decl_isVarient (v)); - v = push (v); - } - mcDebug_assert (decl_isVarient (peep ())); - mcDebug_assert (d == (depth ())); -} - - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - VarientCaseLabels (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - VarientCaseLabels (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VarientCaseLabels := - % VAR l, h: node ; % - - % h := NIL % - ConstExpression - % l := pop () % - [ '..' ConstExpression - % h := pop () % - ] - % l, h could be saved if necessary. % - - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node l; - decl_node h; - - h = static_cast (NULL); - ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - l = pop (); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - h = pop (); - } -} - - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - % VAR n: node ; % - - % n := push (makeSet (pop ())) % - - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - - if (mcLexBuf_currenttoken == mcReserved_settok) - { - Expect (mcReserved_settok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_packedsettok) - { - /* avoid dangling else. */ - Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31); - } - Expect (mcReserved_oftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0, stopset1, stopset2); - n = push (decl_makeSet (pop ())); -} - - -/* - PointerType := 'POINTER' 'TO' Type - % VAR n: node ; % - - % n := push (makePointer (pop ())) % - - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); - n = push (decl_makePointer (pop ())); -} - - -/* - ProcedureType := 'PROCEDURE' - % curproc := push (makeProcType ()) % - [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - curproc = push (decl_makeProcType ()); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalTypeList (stopset0, stopset1, stopset2); - } -} - - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_rparatok) - { - Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ProcedureParameters (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44); - } -} - - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - OptReturnType (stopset0, stopset1, stopset2); - } -} - - -/* - OptReturnType := '[' PushQualident - % putReturnType (curproc, pop ()) % - - % putOptReturn (curproc) % - ']' | PushQualident - % putReturnType (curproc, pop ()) % - - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - PushQualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - decl_putReturnType (curproc, pop ()); - decl_putOptReturn (curproc); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - PushQualident (stopset0, stopset1, stopset2); - decl_putReturnType (curproc, pop ()); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier [", 30); - } -} - - -/* - ProcedureParameters := ProcedureParameter - % addParameter (curproc, pop ()) % - { ',' ProcedureParameter - - % addParameter (curproc, pop ()) % - } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - ProcedureParameter (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - decl_addParameter (curproc, pop ()); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureParameter (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - decl_addParameter (curproc, pop ()); - } - /* while */ -} - - -/* - ProcedureParameter := '...' - % VAR n: node ; % - - % n := push (makeVarargs ()) % - | 'VAR' FormalType - % n := push (makeVarParameter (NIL, pop (), curproc, TRUE)) % - | FormalType - % n := push (makeNonVarParameter (NIL, pop (), curproc, TRUE)) % - - - first symbols:identtok, arraytok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - - if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - n = push (decl_makeVarargs ()); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0, stopset1, stopset2); - n = push (decl_makeVarParameter (static_cast (NULL), pop (), curproc, TRUE)); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - FormalType (stopset0, stopset1, stopset2); - n = push (decl_makeNonVarParameter (static_cast (NULL), pop (), curproc, TRUE)); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42); - } -} - - -/* - VarIdent := - % VAR n, a: node ; % - - % n := pop () % - Ident - % checkDuplicate (putIdent (n, curident)) % - - % n := push (n) % - [ '[' ConstExpression - % a := pop () could store, a, into, n. % - ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - decl_node a; - - n = pop (); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - checkDuplicate (decl_putIdent (n, curident)); - n = push (n); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - a = pop (); /* could store, a, into, n. */ - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } -} - - -/* - VarIdentList := - % VAR n: node ; % - - % n := makeIdentList () % - - % n := push (n) % - VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node n; - - n = decl_makeIdentList (); - n = push (n); - VarIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - VarIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VariableDeclaration := - % VAR v, d: node ; % - VarIdentList - % v := pop () % - ':' Type - % d := makeVarDecl (v, pop ()) % - Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node v; - decl_node d; - - VarIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - v = pop (); - Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - d = decl_makeVarDecl (v, pop ()); - Alignment (stopset0, stopset1, stopset2); -} - - -/* - Designator := Qualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Qualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SubDesignator := '.' Ident | '[' ArrayExpList ']' | - '^' - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - Expect (mcReserved_lsbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ArrayExpList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_uparrowtok) - { - /* avoid dangling else. */ - Expect (mcReserved_uparrowtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ^ [ .", 23); - } -} - - -/* - ArrayExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Expression := SimpleExpression [ Relation SimpleExpression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - SimpleExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SimpleExpression := UnaryOrTerm { AddOperator Term } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - UnaryOrTerm (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - AddOperator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - UnaryOrTerm := '+' Term | '-' Term | - Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - Term (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number identifier { - +", 74); - } -} - - -/* - Term := Factor { MulOperator Factor } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Factor (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - MulOperator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Factor (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - Factor := Number | string | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor | ConstAttribute ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - string (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - SetOrDesignatorOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Factor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( identifier { string integer number real number", 70); - } -} - - -/* - SetOrDesignatorOrFunction := Qualident [ Constructor | - SimpleDes - [ ActualParameters ] ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - Constructor (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))))) != 0))) - { - /* avoid dangling else. */ - SimpleDes (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - ActualParameters (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( ^ [ . {", 27); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - Constructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - SimpleDes := { SubDesignator } - - first symbols:periodtok, lsbratok, uparrowtok - - reachend -*/ - -static void SimpleDes (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ActualParameters := '(' [ ExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ExpList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ExitStatement := 'EXIT' - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_exittok, stopset0, stopset1, stopset2); -} - - -/* - ReturnStatement := 'RETURN' [ Expression ] - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_returntok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Expression (stopset0, stopset1, stopset2); - } -} - - -/* - Statement := [ AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement ] - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok - - reachend -*/ - -static void Statement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - AssignmentOrProcedureCall (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_iftok) - { - /* avoid dangling else. */ - IfStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - CaseStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_whiletok) - { - /* avoid dangling else. */ - WhileStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_repeattok) - { - /* avoid dangling else. */ - RepeatStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_looptok) - { - /* avoid dangling else. */ - LoopStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_fortok) - { - /* avoid dangling else. */ - ForStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_withtok) - { - /* avoid dangling else. */ - WithStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_asmtok) - { - /* avoid dangling else. */ - AsmStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_exittok) - { - /* avoid dangling else. */ - ExitStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_returntok) - { - /* avoid dangling else. */ - ReturnStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_retrytok) - { - /* avoid dangling else. */ - RetryStatement (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: RETRY RETURN EXIT ASM WITH FOR LOOP REPEAT WHILE CASE IF identifier", 85); - } - } - /* end of optional [ | ] expression */ -} - - -/* - RetryStatement := 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_retrytok, stopset0, stopset1, stopset2); -} - - -/* - AssignmentOrProcedureCall := Designator ( ':=' Expression | - ActualParameters | - - % epsilon % - ) - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Designator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_becomestok) - { - Expect (mcReserved_becomestok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ActualParameters (stopset0, stopset1, stopset2); - } - /* epsilon */ -} - - -/* - StatementSequence := Statement { ';' Statement } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Statement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Statement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - IfStatement := 'IF' Expression 'THEN' StatementSequence - { 'ELSIF' Expression 'THEN' StatementSequence } - [ 'ELSE' StatementSequence ] 'END' - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_iftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - Expect (mcReserved_thentok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_elsiftok) - { - Expect (mcReserved_elsiftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - Expect (mcReserved_thentok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - CaseStatement := 'CASE' Expression 'OF' Case { '|' - Case } - CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_casetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Case (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Case (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - CaseEndStatement (stopset0, stopset1, stopset2); -} - - -/* - CaseEndStatement := 'END' | 'ELSE' StatementSequence - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_endtok) - { - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - /* avoid dangling else. */ - Expect (mcReserved_elsetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ELSE END", 26); - } -} - - -/* - Case := [ CaseLabelList ':' StatementSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))) - { - CaseLabelList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1, stopset2); - } -} - - -/* - CaseLabelList := CaseLabels { ',' CaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - CaseLabels (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - CaseLabels (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CaseLabels := ConstExpressionNop [ '..' ConstExpressionNop ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0, stopset1, stopset2); - } -} - - -/* - WhileStatement := 'WHILE' Expression 'DO' StatementSequence - 'END' - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_whiletok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - RepeatStatement := 'REPEAT' StatementSequence 'UNTIL' - Expression - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_repeattok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok)))); - Expect (mcReserved_untiltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); -} - - -/* - ForStatement := 'FOR' Ident ':=' Expression 'TO' - Expression [ 'BY' ConstExpressionNop ] - 'DO' StatementSequence 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_becomestok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_dotok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - LoopStatement := 'LOOP' StatementSequence 'END' - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_looptok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - WithStatement := 'WITH' Designator 'DO' StatementSequence - 'END' - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Designator (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - % leaveScope % - - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - ProcedureHeading (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - ProcedureBlock (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - decl_leaveScope (); -} - - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) % - - % enterScope (curproc) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_lookupSym (curident); - decl_enterScope (curproc); -} - - -/* - DefProcedureIdent := Ident - % curproc := lookupSym (curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefProcedureIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_lookupSym (curident); -} - - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42); - } - } - /* end of optional [ | ] expression */ -} - - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent [ FormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalParameters (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_builtintok) - { - Expect (mcReserved_builtintok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40); - } - } - /* end of optional [ | ] expression */ -} - - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Builtin (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefProcedureIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - DefFormalParameters (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - ProcedureBlockBody (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - InitialBlock (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2); - FinalBlock (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - InitialBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_finallytok) - { - Expect (mcReserved_finallytok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - FinalBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - NormalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - ExceptionalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - ConstantDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeDeclaration (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ModuleDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49); - } -} - - -/* - DefFormalParameters := '(' - % paramEnter (curproc) % - [ DefMultiFPSection ] ')' - - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - decl_paramEnter (curproc); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - DefMultiFPSection (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - decl_paramLeave (curproc); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - DefExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - DefMultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FormalParameters := '(' - % paramEnter (curproc) % - [ MultiFPSection ] ')' - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - decl_paramEnter (curproc); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - MultiFPSection (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - decl_paramLeave (curproc); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - AttributeNoReturn := [ NoReturn | - % setNoReturn (curproc, FALSE) % - ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - NoReturn (stopset0, stopset1, stopset2); - } - else - { - decl_setNoReturn (curproc, FALSE); - } - } - /* end of optional [ | ] expression */ -} - - -/* - NoReturn := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void NoReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - decl_setNoReturn (curproc, TRUE); - checkReturnAttribute (); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - AttributeUnused := [ Unused ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Unused (stopset0, stopset1, stopset2); - } -} - - -/* - Unused := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void Unused (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - curisused = FALSE; - checkParameterAttribute (); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - ExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - MultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - NonVarFPSection (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - VarFPSection (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR identifier", 32); - } -} - - -/* - DefExtendedFP := DefOptArg | '...' - % addParameter (curproc, makeVarargs ()) % - - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - DefOptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - decl_addParameter (curproc, decl_makeVarargs ()); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - OptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - VarFPSection := 'VAR' PushIdentList - % VAR l, t: node ; % - ':' FormalType - % t := pop () % - - % l := pop () % - - % curisused := TRUE % - [ AttributeUnused ] - % addVarParameters (curproc, l, t, curisused) % - - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node l; - decl_node t; - - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - PushIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - t = pop (); - l = pop (); - curisused = TRUE; - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } - decl_addVarParameters (curproc, l, t, curisused); -} - - -/* - NonVarFPSection := PushIdentList - % VAR l, t: node ; % - ':' FormalType - % t := pop () % - - % l := pop () % - - % curisused := TRUE % - [ AttributeUnused ] - % addNonVarParameters (curproc, l, t, curisused) % - - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node l; - decl_node t; - - PushIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - t = pop (); - l = pop (); - curisused = TRUE; - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } - decl_addNonVarParameters (curproc, l, t, curisused); -} - - -/* - OptArg := - % VAR p, init, type: node ; id: Name ; % - '[' Ident - % id := curident % - ':' FormalType - % type := pop () % - - % init := NIL % - [ '=' ConstExpression - % init := pop () % - ] ']' - % p := addOptParameter (curproc, id, type, init) % - - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node p; - decl_node init; - decl_node type; - nameKey_Name id; - - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - id = curident; - Expect (mcReserved_colontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - type = pop (); - init = static_cast (NULL); - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - init = pop (); - } - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - p = decl_addOptParameter (curproc, id, type, init); -} - - -/* - DefOptArg := - % VAR p, init, type: node ; id: Name ; % - '[' Ident - % id := curident % - ':' FormalType - % type := pop () % - '=' ConstExpression - % init := pop () % - ']' - % p := addOptParameter (curproc, id, type, init) % - - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node p; - decl_node init; - decl_node type; - nameKey_Name id; - - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - id = curident; - Expect (mcReserved_colontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - type = pop (); - Expect (mcReserved_equaltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - init = pop (); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - p = decl_addOptParameter (curproc, id, type, init); -} - - -/* - FormalType := - % VAR c: CARDINAL ; % - - % VAR n, a, s: node ; % - - % c := 0 % - { 'ARRAY' 'OF' - % INC (c) % - } PushQualident - % pushNunbounded (c) % - - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - unsigned int c; - decl_node n; - decl_node a; - decl_node s; - - c = 0; - while (mcLexBuf_currenttoken == mcReserved_arraytok) - { - Expect (mcReserved_arraytok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - c += 1; - } - /* while */ - PushQualident (stopset0, stopset1, stopset2); - pushNunbounded (c); -} - - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - Block (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); -} - - -/* - Priority := '[' ConstExpressionNop ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_exporttok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_qualifiedtok) - { - Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok) - { - /* avoid dangling else. */ - Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - IdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50); - } - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - FromIdentList := Ident - % importInto (frommodule, curident, curmodule) % - { ',' Ident - % importInto (frommodule, curident, curmodule) % - } - - first symbols:identtok - - cannot reachend -*/ - -static void FromIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - importInto (frommodule, curident, curmodule); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - importInto (frommodule, curident, curmodule); - } - /* while */ -} - - -/* - FromImport := 'FROM' Ident - % frommodule := lookupDef (curident) % - 'IMPORT' FromIdentList ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2); - frommodule = decl_lookupDef (curident); - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FromIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - ImportModuleList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ImportModuleList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_fromtok) - { - FromImport (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_importtok) - { - /* avoid dangling else. */ - WithoutFromImport (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29); - } -} - - -/* - DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR' - string ] - Ident ';' - % curmodule := lookupDef (curident) % - - % enterScope (curmodule) % - - % resetEnumPos (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % setConstExpComplete (curmodule) % - - % leaveScope % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_fortok) - { - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - curmodule = decl_lookupDef (curident); - decl_enterScope (curmodule); - decl_resetEnumPos (curmodule); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Definition (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "definition module", 17); - decl_setConstExpComplete (curmodule); - decl_leaveScope (); -} - - -/* - PushQualident := Ident - % typeExp := push (lookupSym (curident)) % - - % IF typeExp = NIL - THEN - metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident) - END % - [ '.' - % IF NOT isDef (typeExp) - THEN - ErrorArray ('the first component of this qualident must be a definition module') - END % - Ident - % typeExp := replace (lookupInScope (typeExp, curident)) ; - IF typeExp=NIL - THEN - ErrorArray ('identifier not found in definition module') - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void PushQualident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - typeExp = push (decl_lookupSym (curident)); - if (typeExp == NULL) - { - mcMetaError_metaError1 ((const char *) "the symbol {%1k} is not visible in this scope (or any other nested scope)", 73, (const unsigned char *) &curident, (sizeof (curident)-1)); - } - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (! (decl_isDef (typeExp))) - { - ErrorArray ((const char *) "the first component of this qualident must be a definition module", 65); - } - Ident (stopset0, stopset1, stopset2); - typeExp = replace (decl_lookupInScope (typeExp, curident)); - if (typeExp == NULL) - { - ErrorArray ((const char *) "identifier not found in definition module", 41); - } - } -} - - -/* - OptSubrange := [ SubrangeType - % VAR q, s: node ; % - - % s := pop () % - - % q := pop () % - - % putSubrangeType (s, q) % - - % typeExp := push (s) % - ] - - first symbols:lsbratok - - reachend -*/ - -static void OptSubrange (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node q; - decl_node s; - - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - SubrangeType (stopset0, stopset1, stopset2); - s = pop (); - q = pop (); - decl_putSubrangeType (s, q); - typeExp = push (s); - } -} - - -/* - TypeEquiv := PushQualident OptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void TypeEquiv (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - PushQualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - OptSubrange (stopset0, stopset1, stopset2); -} - - -/* - EnumIdentList := - % VAR f: node ; % - - % typeExp := push (makeEnum ()) % - Ident - % f := makeEnumField (typeExp, curident) % - { ',' Ident - % f := makeEnumField (typeExp, curident) % - } - - first symbols:identtok - - cannot reachend -*/ - -static void EnumIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - decl_node f; - - typeExp = push (decl_makeEnum ()); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - f = decl_makeEnumField (typeExp, curident); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - f = decl_makeEnumField (typeExp, curident); - } - /* while */ -} - - -/* - Enumeration := '(' EnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - EnumIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - SimpleType := - % VAR d: CARDINAL ; % - - % d := depth () % - ( TypeEquiv | Enumeration | - SubrangeType ) - % assert (d = depth () - 1) % - - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - unsigned int d; - - d = depth (); - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeEquiv (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Enumeration (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - SubrangeType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: [ ( identifier", 32); - } - mcDebug_assert (d == ((depth ())-1)); -} - - -/* - Type := SimpleType | ArrayType | RecordType | - SetType | PointerType | ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void Type (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - SimpleType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_arraytok) - { - /* avoid dangling else. */ - ArrayType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_recordtok) - { - /* avoid dangling else. */ - RecordType (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok)) - { - /* avoid dangling else. */ - SetType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_pointertok) - { - /* avoid dangling else. */ - PointerType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80); - } -} - - -/* - TypeDeclaration := { Ident - % typeDes := lookupSym (curident) % - ( ';' | '=' Type - % putType (typeDes, pop ()) % - Alignment ';' ) } - - first symbols:identtok - - reachend -*/ - -static void TypeDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - typeDes = decl_lookupSym (curident); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_equaltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - decl_putType (typeDes, pop ()); - Alignment (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: = ;", 21); - } - } - /* while */ -} - - -/* - Definition := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - ConstantDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeDeclaration (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - DefProcedureHeading (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42); - } -} - - -/* - AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_asmtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_volatiletok) - { - Expect (mcReserved_volatiletok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmOperands (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - string (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - AsmOperandSpec (stopset0, stopset1, stopset2); - } -} - - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - TrashList (stopset0, stopset1, stopset2); - } - } - } -} - - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok)) - { - AsmElement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmElement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - NamedOperand (stopset0, stopset1, stopset2); - } -} - - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - AsmOperandName (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - string (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp3_CompilationUnit (void) -{ - stk = mcStack_init (); - WasNoError = TRUE; - FileUnit ((mcp3_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp3_SetOfStop1) 0, (mcp3_SetOfStop2) 0); - mcStack_kill (&stk); - return WasNoError; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcp3_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcp3_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gmcp4.c b/gcc/m2/mc-boot/Gmcp4.c deleted file mode 100644 index 5eab5ae58edf..000000000000 --- a/gcc/m2/mc-boot/Gmcp4.c +++ /dev/null @@ -1,7717 +0,0 @@ -/* do not edit automatically generated by mc from mcp4. */ -/* output from mc-4.bnf, automatically generated do not edit. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING. If not, -see . */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcp4_H -#define _mcp4_C - -# include "GDynamicStrings.h" -# include "GmcError.h" -# include "GnameKey.h" -# include "GmcPrintf.h" -# include "GmcDebug.h" -# include "GmcReserved.h" -# include "GmcMetaError.h" -# include "GmcStack.h" -# include "GmcLexBuf.h" -# include "Gdecl.h" - -# define Pass1 FALSE -# define Debugging FALSE -typedef unsigned int mcp4_stop0; - -typedef unsigned int mcp4_SetOfStop0; - -typedef unsigned int mcp4_stop1; - -typedef unsigned int mcp4_SetOfStop1; - -typedef unsigned int mcp4_stop2; - -typedef unsigned int mcp4_SetOfStop2; - -static unsigned int WasNoError; -static nameKey_Name curstring; -static nameKey_Name curident; -static decl_node curproc; -static decl_node typeDes; -static decl_node typeExp; -static decl_node curmodule; -static mcStack_stack stk; - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp4_CompilationUnit (void); - -/* - push - -*/ - -static decl_node push (decl_node n); - -/* - pop - -*/ - -static decl_node pop (void); - -/* - replace - -*/ - -static decl_node replace (decl_node n); - -/* - peep - returns the top node on the stack without removing it. -*/ - -static decl_node peep (void); - -/* - depth - returns the depth of the stack. -*/ - -static unsigned int depth (void); - -/* - checkDuplicate - -*/ - -static void checkDuplicate (unsigned int b); - -/* - checkDuplicate - -*/ - -static void ErrorString (DynamicStrings_String s); - -/* - checkDuplicate - -*/ - -static void ErrorArray (const char *a_, unsigned int _a_high); - -/* - pushNunbounded - -*/ - -static void pushNunbounded (unsigned int c); - -/* - makeIndexedArray - builds and returns an array of type, t, with, c, indices. -*/ - -static decl_node makeIndexedArray (unsigned int c, decl_node t); - -/* - importInto - from, m, import, name, into module, current. - It checks to see if curident is an enumeration type - and if so automatically includes all enumeration fields - as well. -*/ - -static void importInto (decl_node m, nameKey_Name name, decl_node current); - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high); - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void); - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t); - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t); - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - string - -*/ - -static void string (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Integer - -*/ - -static void Integer (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Real - -*/ - -static void Real (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % leaveScope % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % leaveScope ; leaveScope % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstantDeclaration := - % VAR d, e: node ; % - Ident - % d := lookupSym (curident) % - '=' ConstExpression - % e := pop () % - - % assert (isConst (d)) % - - % putConst (d, e) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstExpression := - % VAR c, l, r: node ; op: toktype ; d: CARDINAL ; % - - % d := depth () % - - % c := push (getNextConstExp ()) % - SimpleConstExpr - % op := currenttoken % - [ Relation SimpleConstExpr - % r := pop () % - - % l := pop () % - - % l := push (makeBinaryTok (op, l, r)) % - ] - % c := replace (fixupConstExp (c, pop ())) % - - % assert (d+1 = depth ()) % - - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SimpleConstExpr := - % VAR op: toktype ; n: node ; % - UnaryOrConstTerm - % n := pop () % - { - % op := currenttoken % - AddOperator ConstTerm - % n := makeBinaryTok (op, n, pop ()) % - } - % n := push (n) % - - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - UnaryOrConstTerm := - % VAR n: node ; % - '+' ConstTerm - % n := push (makeUnaryTok (plustok, pop ())) % - | '-' ConstTerm - % n := push (makeUnaryTok (minustok, pop ())) % - | ConstTerm - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstTerm := - % VAR op: toktype ; n: node ; % - ConstFactor - % n := pop () % - { - % op := currenttoken % - MulOperator ConstFactor - % n := makeBinaryTok (op, n, pop ()) % - } - % n := push (n) % - - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - NotConstFactor := 'NOT' ConstFactor - % VAR n: node ; % - - % n := push (makeUnaryTok (nottok, pop ())) % - - - first symbols:nottok - - cannot reachend -*/ - -static void NotConstFactor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstFactor := Number | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpression ')' | - NotConstFactor | - ConstAttribute - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstString := string - % VAR n: node ; % - - % n := push (makeString (curstring)) % - - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstComponentElement := ConstExpression - % VAR l, h, n: node ; % - - % l := pop () % - - % h := NIL % - [ '..' ConstExpression - - % h := pop () % - - % ErrorArray ('implementation restriction range is not allowed') % - ] - % n := push (includeSetValue (pop (), l, h)) % - - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstComponentElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstComponentValue := ConstComponentElement [ 'BY' - - % ErrorArray ('implementation restriction BY not allowed') % - ConstExpression ] - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstComponentValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstArraySetRecordValue := ConstComponentValue - { ',' ConstComponentValue } - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstArraySetRecordValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstConstructor := '{' - % VAR n: node ; % - - % n := push (makeSetValue ()) % - [ ConstArraySetRecordValue ] - '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void ConstConstructor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstSetOrQualidentOrFunction := - % VAR q, p, n: node ; d: CARDINAL ; % - - % d := depth () % - PushQualident - % assert (d+1 = depth ()) % - [ ConstConstructor - - % p := pop () % - - % q := pop () % - - % n := push (putSetValue (p, q)) % - - % assert (d+1 = depth ()) % - | - ConstActualParameters - - % p := pop () % - - % q := pop () % - - % n := push (makeFuncCall (q, p)) % - - % assert (d+1 = depth ()) % - ] | - - % d := depth () % - ConstConstructor - - % assert (d+1 = depth ()) % - - - first symbols:identtok, lcbratok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstActualParameters := '(' - % VAR n: node ; % - - % n := push (makeExpList ()) % - [ ConstExpList ] ')' - % assert (isExpList (peep ())) % - - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstExpList := - % VAR p, n: node ; % - - % p := peep () % - - % assert (isExpList (p)) % - ConstExpression - % putExpList (p, pop ()) % - - % assert (p = peep ()) % - - % assert (isExpList (peep ())) % - { ',' ConstExpression - % putExpList (p, pop ()) % - - % assert (isExpList (peep ())) % - } - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ConstAttributeExpression := Ident - % VAR n: node ; % - - % n := push (getBuiltinConst (curident)) % - | '<' Qualident ',' - Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AlignmentExpression := '(' ConstExpression ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - PushIdentList := - % VAR n: node ; % - - % n := makeIdentList () % - Ident - % checkDuplicate (putIdent (n, curident)) % - { ',' Ident - % checkDuplicate (putIdent (n, curident)) % - } - % n := push (n) % - - - first symbols:identtok - - cannot reachend -*/ - -static void PushIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SubrangeType := '[' ConstExpression '..' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ArrayType := 'ARRAY' SimpleType { ',' SimpleType } - 'OF' Type - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - RecordType := 'RECORD' [ DefaultRecordAttributes ] - FieldListSequence 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - PragmaConstExpression := [ '(' ConstExpression ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AttributeExpression := Ident '(' ConstExpression - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FieldList := IdentList ':' Type RecordFieldPragma | - 'CASE' CaseTag 'OF' Varient { '|' Varient } - [ 'ELSE' FieldListSequence ] 'END' - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - TagIdent := Ident | - % curident := NulName % - - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - CaseTag := TagIdent [ ':' Qualident ] - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Varient := [ VarientCaseLabelList ':' FieldListSequence ] - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - VarientCaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - PointerType := 'POINTER' 'TO' Type - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProcedureType := 'PROCEDURE' [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - OptReturnType := '[' Qualident ']' | - Qualident - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProcedureParameters := ProcedureParameter { ',' - ProcedureParameter } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProcedureParameter := '...' | 'VAR' FormalType | - FormalType - - first symbols:identtok, arraytok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - VarIdent := Ident [ '[' ConstExpression - % VAR n: node ; % - - % n := pop () % - ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - VarIdentList := VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - VariableDeclaration := VarIdentList ':' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Designator := Qualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SubDesignator := '.' Ident | '[' ArrayExpList ']' | - '^' - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ArrayExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Expression := SimpleExpression [ Relation SimpleExpression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SimpleExpression := UnaryOrTerm { AddOperator Term } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - UnaryOrTerm := '+' Term | '-' Term | - Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Term := Factor { MulOperator Factor } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Factor := Number | string | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor | ConstAttribute ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ComponentElement := Expression [ '..' Expression - - % ErrorArray ('implementation restriction range not allowed') % - ] - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ComponentValue := ComponentElement [ 'BY' - % ErrorArray ('implementation restriction BY not allowed') % - Expression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Constructor := '{' [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SetOrDesignatorOrFunction := Qualident [ Constructor | - SimpleDes - [ ActualParameters ] ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SimpleDes := { SubDesignator } - - first symbols:periodtok, lsbratok, uparrowtok - - reachend -*/ - -static void SimpleDes (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ActualParameters := '(' [ ExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ExitStatement := 'EXIT' - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ReturnStatement := 'RETURN' [ Expression ] - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Statement := [ AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement ] - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok - - reachend -*/ - -static void Statement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - RetryStatement := 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AssignmentOrProcedureCall := Designator ( ':=' Expression | - ActualParameters | - - % epsilon % - ) - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - StatementSequence := Statement { ';' Statement } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - IfStatement := 'IF' Expression 'THEN' StatementSequence - { 'ELSIF' Expression 'THEN' StatementSequence } - [ 'ELSE' StatementSequence ] 'END' - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - CaseStatement := 'CASE' Expression 'OF' Case { '|' - Case } - CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - CaseEndStatement := 'END' | 'ELSE' StatementSequence - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Case := [ CaseLabelList ':' StatementSequence ] - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - CaseLabelList := CaseLabels { ',' CaseLabels } - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - CaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - WhileStatement := 'WHILE' Expression 'DO' StatementSequence - 'END' - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - RepeatStatement := 'REPEAT' StatementSequence 'UNTIL' - Expression - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ForStatement := 'FOR' Ident ':=' Expression 'TO' - Expression [ 'BY' ConstExpression ] - 'DO' StatementSequence 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - LoopStatement := 'LOOP' StatementSequence 'END' - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - WithStatement := 'WITH' Designator 'DO' StatementSequence - 'END' - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - % leaveScope % - - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) % - - % enterScope (curproc) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefProcedureIdent := Ident - % curproc := lookupSym (curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefProcedureIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent [ FormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - NormalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ExceptionalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefFormalParameters := '(' - % paramEnter (curproc) % - [ DefMultiFPSection ] ')' - - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FormalParameters := '(' - % paramEnter (curproc) % - [ MultiFPSection ] ')' - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AttributeNoReturn := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AttributeUnused := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefExtendedFP := DefOptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - VarFPSection := 'VAR' PushIdentList ':' FormalType - [ AttributeUnused ] - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - NonVarFPSection := PushIdentList ':' FormalType - [ AttributeUnused ] - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ] - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefOptArg := '[' Ident ':' FormalType '=' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FormalType := { 'ARRAY' 'OF' } PushQualident - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Priority := '[' ConstExpression ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FromIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void FromIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - FromImport := 'FROM' Ident 'IMPORT' FromIdentList - ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - ImportModuleList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR' - string ] - Ident - % curmodule := lookupDef (curident) % - - % addCommentBody (curmodule) % - ';' - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % leaveScope % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - PushQualident := Ident - % typeExp := push (lookupSym (curident)) % - - % IF typeExp = NIL - THEN - metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident) - END % - [ '.' - % IF NOT isDef (typeExp) - THEN - ErrorArray ('the first component of this qualident must be a definition module') - END % - Ident - % typeExp := replace (lookupInScope (typeExp, curident)) ; - IF typeExp=NIL - THEN - ErrorArray ('identifier not found in definition module') - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void PushQualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - OptSubrange := [ SubrangeType ] - - first symbols:lsbratok - - reachend -*/ - -static void OptSubrange (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - TypeEquiv := PushQualident OptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void TypeEquiv (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - EnumIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void EnumIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Enumeration := '(' EnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - SimpleType := TypeEquiv | Enumeration | - SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Type := SimpleType | ArrayType | RecordType | - SetType | PointerType | ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void Type (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - TypeDeclaration := { Ident ( ';' | '=' Type Alignment - ';' ) } - - first symbols:identtok - - reachend -*/ - -static void TypeDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefQualident := Ident - % typeExp := lookupSym (curident) % - [ '.' - % IF NOT isDef (typeExp) - THEN - ErrorArray ('the first component of this qualident must be a definition module') - END % - Ident - % typeExp := lookupInScope (typeExp, curident) ; - IF typeExp=NIL - THEN - ErrorArray ('identifier not found in definition module') - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void DefQualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefTypeEquiv := DefQualident OptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void DefTypeEquiv (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefEnumIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void DefEnumIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefEnumeration := '(' DefEnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void DefEnumeration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefSimpleType := DefTypeEquiv | DefEnumeration | - SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void DefSimpleType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefType := DefSimpleType | ArrayType | - RecordType | SetType | PointerType | - ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void DefType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefTypeDeclaration := { Ident ( ';' | '=' DefType - Alignment ';' ) } - - first symbols:identtok - - reachend -*/ - -static void DefTypeDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - DefConstantDeclaration := Ident '=' ConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void DefConstantDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - Definition := 'CONST' { DefConstantDeclaration ';' } | - 'TYPE' { DefTypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2); - - -/* - push - -*/ - -static decl_node push (decl_node n) -{ - return static_cast (mcStack_push (stk, reinterpret_cast (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - pop - -*/ - -static decl_node pop (void) -{ - return static_cast (mcStack_pop (stk)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - replace - -*/ - -static decl_node replace (decl_node n) -{ - return static_cast (mcStack_replace (stk, reinterpret_cast (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - peep - returns the top node on the stack without removing it. -*/ - -static decl_node peep (void) -{ - return push (pop ()); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - depth - returns the depth of the stack. -*/ - -static unsigned int depth (void) -{ - return mcStack_depth (stk); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkDuplicate - -*/ - -static void checkDuplicate (unsigned int b) -{ -} - - -/* - checkDuplicate - -*/ - -static void ErrorString (DynamicStrings_String s) -{ - mcError_errorStringAt (s, mcLexBuf_getTokenNo ()); - WasNoError = FALSE; -} - - -/* - checkDuplicate - -*/ - -static void ErrorArray (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - ErrorString (DynamicStrings_InitString ((const char *) a, _a_high)); -} - - -/* - pushNunbounded - -*/ - -static void pushNunbounded (unsigned int c) -{ - decl_node type; - decl_node array; - decl_node subrange; - - while (c != 0) - { - type = pop (); - subrange = decl_makeSubrange (static_cast (NULL), static_cast (NULL)); - decl_putSubrangeType (subrange, decl_getCardinal ()); - array = decl_makeArray (subrange, type); - decl_putUnbounded (array); - type = push (array); - c -= 1; - } -} - - -/* - makeIndexedArray - builds and returns an array of type, t, with, c, indices. -*/ - -static decl_node makeIndexedArray (unsigned int c, decl_node t) -{ - decl_node i; - - while (c > 0) - { - t = decl_makeArray (pop (), t); - c -= 1; - } - return t; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - importInto - from, m, import, name, into module, current. - It checks to see if curident is an enumeration type - and if so automatically includes all enumeration fields - as well. -*/ - -static void importInto (decl_node m, nameKey_Name name, decl_node current) -{ - decl_node s; - decl_node o; - - mcDebug_assert (decl_isDef (m)); - mcDebug_assert (((decl_isDef (current)) || (decl_isModule (current))) || (decl_isImp (current))); - s = decl_lookupExported (m, name); - if (s == NULL) - { - mcMetaError_metaError2 ((const char *) "{%1k} was not exported from definition module {%2a}", 51, (const unsigned char *) &name, (sizeof (name)-1), (const unsigned char *) &m, (sizeof (m)-1)); - } - else - { - o = decl_import (current, s); - if (s != o) - { - mcMetaError_metaError2 ((const char *) "{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}", 87, (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &o, (sizeof (o)-1)); - } - } -} - - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high) -{ - DynamicStrings_String s; - char desc[_desc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (desc, desc_, _desc_high+1); - - if ((decl_getSymName (module)) != name) - { - s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41); - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high))); - ErrorString (s); - } -} - - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - unsigned int n; - DynamicStrings_String str; - DynamicStrings_String message; - - n = 0; - message = DynamicStrings_InitString ((const char *) "", 0); - if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6))); - n += 1; - } - if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11))); - n += 1; - } - if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10))); - n += 1; - } - if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14))); - n += 1; - } - if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10))); - n += 1; - } - if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11))); - n += 1; - } - if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13))); - n += 1; - } - if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3))); - n += 1; - } - if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8))); - n += 1; - } - if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3))); - n += 1; - } - if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4))); - n += 1; - } - if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5))); - n += 1; - } - if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3))); - n += 1; - } - if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5))); - n += 1; - } - if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4))); - n += 1; - } - if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2))); - n += 1; - } - if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4))); - n += 1; - } - if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3))); - n += 1; - } - if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6))); - n += 1; - } - if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5))); - n += 1; - } - if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6))); - n += 1; - } - if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3))); - n += 1; - } - if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6))); - n += 1; - } - if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11))); - n += 1; - } - if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9))); - n += 1; - } - if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9))); - n += 1; - } - if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7))); - n += 1; - } - if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9))); - n += 1; - } - if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2))); - n += 1; - } - if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2))); - n += 1; - } - if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3))); - n += 1; - } - if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6))); - n += 1; - } - if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3))); - n += 1; - } - if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4))); - n += 1; - } - if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2))); - n += 1; - } - if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14))); - n += 1; - } - if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2))); - n += 1; - } - if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4))); - n += 1; - } - if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3))); - n += 1; - } - if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7))); - n += 1; - } - if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4))); - n += 1; - } - if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6))); - n += 1; - } - if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3))); - n += 1; - } - if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5))); - n += 1; - } - if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4))); - n += 1; - } - if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2))); - n += 1; - } - if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3))); - n += 1; - } - if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10))); - n += 1; - } - if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5))); - n += 1; - } - if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4))); - n += 1; - } - if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2))); - n += 1; - } - if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5))); - n += 1; - } - if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5))); - n += 1; - } - if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3))); - n += 1; - } - if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2))); - n += 1; - } - if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2))); - n += 1; - } - if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2))); - n += 1; - } - if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2))); - n += 1; - } - if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1))); - n += 1; - } - if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1))); - n += 1; - } - if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1))); - n += 1; - } - if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1))); - n += 1; - } - if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))); - n += 1; - } - if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1))); - n += 1; - } - if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1))); - n += 1; - } - if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1))); - n += 1; - } - if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1))); - n += 1; - } - if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1))); - n += 1; - } - if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ','); - n += 1; - } - if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ','); - n += 1; - } - if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1))); - n += 1; - } - if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1))); - n += 1; - } - if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1))); - n += 1; - } - if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1))); - n += 1; - } - if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1))); - n += 1; - } - if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1))); - n += 1; - } - if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1))); - n += 1; - } - if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1))); - n += 1; - } - if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1))); - n += 1; - } - if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2))); - n += 1; - } - if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0)) - {} /* empty. */ - /* eoftok has no token name (needed to generate error messages) */ - if (n == 0) - { - str = DynamicStrings_InitString ((const char *) " syntax error", 13); - message = DynamicStrings_KillString (message); - } - else if (n == 1) - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9))); - } - else - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message); - message = DynamicStrings_KillString (message); - } - return str; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void) -{ - DynamicStrings_String str; - - str = DynamicStrings_InitString ((const char *) "", 0); - switch (mcLexBuf_currenttoken) - { - case mcReserved_stringtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_realtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_identtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_integertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_inlinetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_builtintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_attributetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str)); - break; - - case mcReserved_filetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_linetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_datetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_volatiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_asmtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_withtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_whiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_vartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_untiltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_typetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_totok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_thentok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_settok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_returntok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_retrytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_repeattok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_remtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_recordtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_unqualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_qualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_proceduretok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_pointertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_packedsettok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_ortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_oftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_nottok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_moduletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_modtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_looptok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_intok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_importtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_implementationtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_iftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_fromtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_fortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_finallytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_exporttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_exittok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_excepttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_endtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsiftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_dotok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_divtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_definitiontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_consttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_casetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_bytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_begintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_arraytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_andtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_colontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_rdirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_ldirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_greaterequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessgreatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_hashtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_equaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_uparrowtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_semicolontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_commatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_ambersandtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_dividetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_timestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_minustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_plustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_doublequotestok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str)); - break; - - case mcReserved_singlequotetok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str)); - break; - - case mcReserved_greatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lesstok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_bartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_becomestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_eoftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str)); - break; - - - default: - break; - } - ErrorString (str); -} - - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - DescribeError (); - if (Debugging) - { - mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21); - } - /* - yes the ORD(currenttoken) looks ugly, but it is *much* safer than - using currenttoken= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - mcLexBuf_getToken (); - } - if (Debugging) - { - mcPrintf_printf0 ((const char *) " ***\\n", 6); - } -} - - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - SyntaxError (stopset0, stopset1, stopset2); - } -} - - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t) -{ - mcp4_SetOfStop0 s0; - mcp4_SetOfStop1 s1; - mcp4_SetOfStop2 s2; - DynamicStrings_String str; - - s0 = (mcp4_SetOfStop0) 0; - s1 = (mcp4_SetOfStop1) 0; - s2 = (mcp4_SetOfStop2) 0; - if ( ((unsigned int) (t)) < 32) - { - s0 = (mcp4_SetOfStop0) ((1 << (t-mcReserved_eoftok))); - } - else if ( ((unsigned int) (t)) < 64) - { - /* avoid dangling else. */ - s1 = (mcp4_SetOfStop1) ((1 << (t-mcReserved_arraytok))); - } - else - { - /* avoid dangling else. */ - s2 = (mcp4_SetOfStop2) ((1 << (t-mcReserved_recordtok))); - } - str = DescribeStop (s0, s1, s2); - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str)); - mcError_errorStringAt (str, mcLexBuf_getTokenNo ()); -} - - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t) -{ - WarnMissingToken (t); - if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok)) - { - if (Debugging) - { - mcPrintf_printf0 ((const char *) "inserting token\\n", 17); - } - mcLexBuf_insertToken (t); - } -} - - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - WarnMissingToken (t); - mcLexBuf_insertTokenAndRewind (t); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2)))) - { - /* SyntaxCheck would fail since currentoken is not part of the stopset - we check to see whether any of currenttoken might be a commonly omitted token */ - if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2))) - {} /* empty. */ - } -} - - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == t) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (Pass1) - { - PeepToken (stopset0, stopset1, stopset2); - } - } - else - { - MissingToken (t); - } - SyntaxCheck (stopset0, stopset1, stopset2); -} - - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - curident = nameKey_makekey (mcLexBuf_currentstring); - Expect (mcReserved_identtok, stopset0, stopset1, stopset2); -} - - -/* - string - -*/ - -static void string (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - curstring = nameKey_makekey (mcLexBuf_currentstring); - Expect (mcReserved_stringtok, stopset0, stopset1, stopset2); -} - - -/* - Integer - -*/ - -static void Integer (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - n = push (decl_makeLiteralInt (nameKey_makekey (mcLexBuf_currentstring))); - Expect (mcReserved_integertok, stopset0, stopset1, stopset2); -} - - -/* - Real - -*/ - -static void Real (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - n = push (decl_makeLiteralReal (nameKey_makekey (mcLexBuf_currentstring))); - Expect (mcReserved_realtok, stopset0, stopset1, stopset2); -} - - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_definitiontok) - { - DefinitionModule (stopset0, stopset1, stopset2); - } - else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) - { - /* avoid dangling else. */ - ImplementationOrProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50); - } -} - - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % leaveScope % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupModule (curident); - decl_enterScope (curmodule); - decl_resetConstExpPos (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "program module", 14); - decl_leaveScope (); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % leaveScope ; leaveScope % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupImp (curident); - decl_enterScope (decl_lookupDef (curident)); - decl_enterScope (curmodule); - decl_resetConstExpPos (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "implementation module", 21); - decl_leaveScope (); - decl_leaveScope (); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_implementationtok) - { - ImplementationModule (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39); - } -} - - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_integertok) - { - Integer (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_realtok) - { - /* avoid dangling else. */ - Real (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: real number integer number", 44); - } -} - - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstantDeclaration := - % VAR d, e: node ; % - Ident - % d := lookupSym (curident) % - '=' ConstExpression - % e := pop () % - - % assert (isConst (d)) % - - % putConst (d, e) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node d; - decl_node e; - - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - d = decl_lookupSym (curident); - Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - e = pop (); - mcDebug_assert (decl_isConst (d)); - decl_putConst (d, e); -} - - -/* - ConstExpression := - % VAR c, l, r: node ; op: toktype ; d: CARDINAL ; % - - % d := depth () % - - % c := push (getNextConstExp ()) % - SimpleConstExpr - % op := currenttoken % - [ Relation SimpleConstExpr - % r := pop () % - - % l := pop () % - - % l := push (makeBinaryTok (op, l, r)) % - ] - % c := replace (fixupConstExp (c, pop ())) % - - % assert (d+1 = depth ()) % - - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node c; - decl_node l; - decl_node r; - mcReserved_toktype op; - unsigned int d; - - d = depth (); - c = push (decl_getNextConstExp ()); - SimpleConstExpr (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - op = mcLexBuf_currenttoken; - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleConstExpr (stopset0, stopset1, stopset2); - r = pop (); - l = pop (); - l = push (decl_makeBinaryTok (op, l, r)); - } - c = replace (decl_fixupConstExp (c, pop ())); - mcDebug_assert ((d+1) == (depth ())); -} - - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_hashtok) - { - /* avoid dangling else. */ - Expect (mcReserved_hashtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_intok) - { - /* avoid dangling else. */ - Expect (mcReserved_intok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37); - } -} - - -/* - SimpleConstExpr := - % VAR op: toktype ; n: node ; % - UnaryOrConstTerm - % n := pop () % - { - % op := currenttoken % - AddOperator ConstTerm - % n := makeBinaryTok (op, n, pop ()) % - } - % n := push (n) % - - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - mcReserved_toktype op; - decl_node n; - - UnaryOrConstTerm (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - n = pop (); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - op = mcLexBuf_currenttoken; - AddOperator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstTerm (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - n = decl_makeBinaryTok (op, n, pop ()); - } - /* while */ - n = push (n); -} - - -/* - UnaryOrConstTerm := - % VAR n: node ; % - '+' ConstTerm - % n := push (makeUnaryTok (plustok, pop ())) % - | '-' ConstTerm - % n := push (makeUnaryTok (minustok, pop ())) % - | ConstTerm - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - n = push (decl_makeUnaryTok (mcReserved_plustok, pop ())); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - n = push (decl_makeUnaryTok (mcReserved_minustok, pop ())); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ConstTerm (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ { string identifier - +", 88); - } -} - - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ortok) - { - /* avoid dangling else. */ - Expect (mcReserved_ortok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: OR - +", 24); - } -} - - -/* - ConstTerm := - % VAR op: toktype ; n: node ; % - ConstFactor - % n := pop () % - { - % op := currenttoken % - MulOperator ConstFactor - % n := makeBinaryTok (op, n, pop ()) % - } - % n := push (n) % - - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - mcReserved_toktype op; - decl_node n; - - ConstFactor (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - n = pop (); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - op = mcLexBuf_currenttoken; - MulOperator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstFactor (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - n = decl_makeBinaryTok (op, n, pop ()); - } - /* while */ - n = push (n); -} - - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_timestok) - { - Expect (mcReserved_timestok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_dividetok) - { - /* avoid dangling else. */ - Expect (mcReserved_dividetok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_divtok) - { - /* avoid dangling else. */ - Expect (mcReserved_divtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_modtok) - { - /* avoid dangling else. */ - Expect (mcReserved_modtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_remtok) - { - /* avoid dangling else. */ - Expect (mcReserved_remtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_andtok) - { - /* avoid dangling else. */ - Expect (mcReserved_andtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ambersandtok) - { - /* avoid dangling else. */ - Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39); - } -} - - -/* - NotConstFactor := 'NOT' ConstFactor - % VAR n: node ; % - - % n := push (makeUnaryTok (nottok, pop ())) % - - - first symbols:nottok - - cannot reachend -*/ - -static void NotConstFactor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_nottok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstFactor (stopset0, stopset1, stopset2); - n = push (decl_makeUnaryTok (mcReserved_nottok, pop ())); -} - - -/* - ConstFactor := Number | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpression ')' | - NotConstFactor | - ConstAttribute - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - ConstString (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - NotConstFactor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( { identifier string integer number real number", 84); - } -} - - -/* - ConstString := string - % VAR n: node ; % - - % n := push (makeString (curstring)) % - - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - string (stopset0, stopset1, stopset2); - n = push (decl_makeString (curstring)); -} - - -/* - ConstComponentElement := ConstExpression - % VAR l, h, n: node ; % - - % l := pop () % - - % h := NIL % - [ '..' ConstExpression - - % h := pop () % - - % ErrorArray ('implementation restriction range is not allowed') % - ] - % n := push (includeSetValue (pop (), l, h)) % - - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstComponentElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node l; - decl_node h; - decl_node n; - - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - l = pop (); - h = static_cast (NULL); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - h = pop (); - ErrorArray ((const char *) "implementation restriction range is not allowed", 47); - } - n = push (decl_includeSetValue (pop (), l, h)); -} - - -/* - ConstComponentValue := ConstComponentElement [ 'BY' - - % ErrorArray ('implementation restriction BY not allowed') % - ConstExpression ] - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstComponentValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - ConstComponentElement (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ErrorArray ((const char *) "implementation restriction BY not allowed", 41); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - ConstArraySetRecordValue := ConstComponentValue - { ',' ConstComponentValue } - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstArraySetRecordValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - ConstComponentValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstComponentValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstConstructor := '{' - % VAR n: node ; % - - % n := push (makeSetValue ()) % - [ ConstArraySetRecordValue ] - '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void ConstConstructor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_lcbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - n = push (decl_makeSetValue ()); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ConstArraySetRecordValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - ConstSetOrQualidentOrFunction := - % VAR q, p, n: node ; d: CARDINAL ; % - - % d := depth () % - PushQualident - % assert (d+1 = depth ()) % - [ ConstConstructor - - % p := pop () % - - % q := pop () % - - % n := push (putSetValue (p, q)) % - - % assert (d+1 = depth ()) % - | - ConstActualParameters - - % p := pop () % - - % q := pop () % - - % n := push (makeFuncCall (q, p)) % - - % assert (d+1 = depth ()) % - ] | - - % d := depth () % - ConstConstructor - - % assert (d+1 = depth ()) % - - - first symbols:identtok, lcbratok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node q; - decl_node p; - decl_node n; - unsigned int d; - - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - d = depth (); - PushQualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - mcDebug_assert ((d+1) == (depth ())); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - ConstConstructor (stopset0, stopset1, stopset2); - p = pop (); - q = pop (); - n = push (decl_putSetValue (p, q)); - mcDebug_assert ((d+1) == (depth ())); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ConstActualParameters (stopset0, stopset1, stopset2); - p = pop (); - q = pop (); - n = push (decl_makeFuncCall (q, p)); - mcDebug_assert ((d+1) == (depth ())); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( {", 21); - } - } - /* end of optional [ | ] expression */ - } - else - { - d = depth (); - ConstConstructor (stopset0, stopset1, stopset2); - mcDebug_assert ((d+1) == (depth ())); - } -} - - -/* - ConstActualParameters := '(' - % VAR n: node ; % - - % n := push (makeExpList ()) % - [ ConstExpList ] ')' - % assert (isExpList (peep ())) % - - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - n = push (decl_makeExpList ()); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ConstExpList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - mcDebug_assert (decl_isExpList (peep ())); -} - - -/* - ConstExpList := - % VAR p, n: node ; % - - % p := peep () % - - % assert (isExpList (p)) % - ConstExpression - % putExpList (p, pop ()) % - - % assert (p = peep ()) % - - % assert (isExpList (peep ())) % - { ',' ConstExpression - % putExpList (p, pop ()) % - - % assert (isExpList (peep ())) % - } - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node p; - decl_node n; - - p = peep (); - mcDebug_assert (decl_isExpList (p)); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - decl_putExpList (p, pop ()); - mcDebug_assert (p == (peep ())); - mcDebug_assert (decl_isExpList (peep ())); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - decl_putExpList (p, pop ()); - mcDebug_assert (decl_isExpList (peep ())); - } - /* while */ -} - - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstAttributeExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ConstAttributeExpression := Ident - % VAR n: node ; % - - % n := push (getBuiltinConst (curident)) % - | '<' Qualident ',' - Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - n = push (decl_getBuiltinConst (curident)); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: < identifier", 30); - } -} - - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - AlignmentExpression (stopset0, stopset1, stopset2); - } -} - - -/* - AlignmentExpression := '(' ConstExpression ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - ByteAlignment (stopset0, stopset1, stopset2); - } -} - - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - PushIdentList := - % VAR n: node ; % - - % n := makeIdentList () % - Ident - % checkDuplicate (putIdent (n, curident)) % - { ',' Ident - % checkDuplicate (putIdent (n, curident)) % - } - % n := push (n) % - - - first symbols:identtok - - cannot reachend -*/ - -static void PushIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - n = decl_makeIdentList (); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - checkDuplicate (decl_putIdent (n, curident)); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - checkDuplicate (decl_putIdent (n, curident)); - } - /* while */ - n = push (n); -} - - -/* - SubrangeType := '[' ConstExpression '..' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - ArrayType := 'ARRAY' SimpleType { ',' SimpleType } - 'OF' Type - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_arraytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - /* while */ - Expect (mcReserved_oftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); -} - - -/* - RecordType := 'RECORD' [ DefaultRecordAttributes ] - FieldListSequence 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_recordtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - DefaultRecordAttributes (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - FieldListSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - PragmaConstExpression (stopset0, stopset1, stopset2); -} - - -/* - PragmaConstExpression := [ '(' ConstExpression ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeExpression := Ident '(' ConstExpression - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - FieldListStatement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListStatement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - FieldList (stopset0, stopset1, stopset2); - } -} - - -/* - FieldList := IdentList ':' Type RecordFieldPragma | - 'CASE' CaseTag 'OF' Varient { '|' Varient } - [ 'ELSE' FieldListSequence ] 'END' - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - IdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - RecordFieldPragma (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - Expect (mcReserved_casetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - CaseTag (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Varient (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Varient (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: CASE identifier", 33); - } -} - - -/* - TagIdent := Ident | - % curident := NulName % - - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else - { - curident = nameKey_NulName; - } -} - - -/* - CaseTag := TagIdent [ ':' Qualident ] - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - TagIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0, stopset1, stopset2); - } -} - - -/* - Varient := [ VarientCaseLabelList ':' FieldListSequence ] - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - VarientCaseLabelList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1, stopset2); - } -} - - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - VarientCaseLabels (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - VarientCaseLabels (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VarientCaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_settok) - { - Expect (mcReserved_settok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_packedsettok) - { - /* avoid dangling else. */ - Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31); - } - Expect (mcReserved_oftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0, stopset1, stopset2); -} - - -/* - PointerType := 'POINTER' 'TO' Type - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); -} - - -/* - ProcedureType := 'PROCEDURE' [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalTypeList (stopset0, stopset1, stopset2); - } -} - - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_rparatok) - { - Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ProcedureParameters (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44); - } -} - - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - OptReturnType (stopset0, stopset1, stopset2); - } -} - - -/* - OptReturnType := '[' Qualident ']' | - Qualident - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier [", 30); - } -} - - -/* - ProcedureParameters := ProcedureParameter { ',' - ProcedureParameter } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - ProcedureParameter (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureParameter (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ProcedureParameter := '...' | 'VAR' FormalType | - FormalType - - first symbols:identtok, arraytok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - FormalType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42); - } -} - - -/* - VarIdent := Ident [ '[' ConstExpression - % VAR n: node ; % - - % n := pop () % - ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - decl_node n; - - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - n = pop (); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } -} - - -/* - VarIdentList := VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - VarIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - VarIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VariableDeclaration := VarIdentList ':' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - VarIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0, stopset1, stopset2); -} - - -/* - Designator := Qualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Qualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SubDesignator := '.' Ident | '[' ArrayExpList ']' | - '^' - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - Expect (mcReserved_lsbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ArrayExpList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_uparrowtok) - { - /* avoid dangling else. */ - Expect (mcReserved_uparrowtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ^ [ .", 23); - } -} - - -/* - ArrayExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ExpList := Expression { ',' Expression } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Expression := SimpleExpression [ Relation SimpleExpression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - SimpleExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleExpression (stopset0, stopset1, stopset2); - } -} - - -/* - SimpleExpression := UnaryOrTerm { AddOperator Term } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - UnaryOrTerm (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - AddOperator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - UnaryOrTerm := '+' Term | '-' Term | - Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - Term (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number identifier { - +", 74); - } -} - - -/* - Term := Factor { MulOperator Factor } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Factor (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - MulOperator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Factor (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - Factor := Number | string | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor | ConstAttribute ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - string (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - SetOrDesignatorOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Factor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( identifier { string integer number real number", 70); - } -} - - -/* - ComponentElement := Expression [ '..' Expression - - % ErrorArray ('implementation restriction range not allowed') % - ] - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); - ErrorArray ((const char *) "implementation restriction range not allowed", 44); - } -} - - -/* - ComponentValue := ComponentElement [ 'BY' - % ErrorArray ('implementation restriction BY not allowed') % - Expression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - ComponentElement (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ErrorArray ((const char *) "implementation restriction BY not allowed", 41); - Expression (stopset0, stopset1, stopset2); - } -} - - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - ComponentValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ComponentValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Constructor := '{' [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lcbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ArraySetRecordValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - SetOrDesignatorOrFunction := Qualident [ Constructor | - SimpleDes - [ ActualParameters ] ] | - Constructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - Constructor (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))))) != 0))) - { - /* avoid dangling else. */ - SimpleDes (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - ActualParameters (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( ^ [ . {", 27); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - Constructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - SimpleDes := { SubDesignator } - - first symbols:periodtok, lsbratok, uparrowtok - - reachend -*/ - -static void SimpleDes (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ActualParameters := '(' [ ExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ExpList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ExitStatement := 'EXIT' - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_exittok, stopset0, stopset1, stopset2); -} - - -/* - ReturnStatement := 'RETURN' [ Expression ] - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_returntok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Expression (stopset0, stopset1, stopset2); - } -} - - -/* - Statement := [ AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement ] - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok - - reachend -*/ - -static void Statement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - AssignmentOrProcedureCall (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_iftok) - { - /* avoid dangling else. */ - IfStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - CaseStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_whiletok) - { - /* avoid dangling else. */ - WhileStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_repeattok) - { - /* avoid dangling else. */ - RepeatStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_looptok) - { - /* avoid dangling else. */ - LoopStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_fortok) - { - /* avoid dangling else. */ - ForStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_withtok) - { - /* avoid dangling else. */ - WithStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_asmtok) - { - /* avoid dangling else. */ - AsmStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_exittok) - { - /* avoid dangling else. */ - ExitStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_returntok) - { - /* avoid dangling else. */ - ReturnStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_retrytok) - { - /* avoid dangling else. */ - RetryStatement (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: RETRY RETURN EXIT ASM WITH FOR LOOP REPEAT WHILE CASE IF identifier", 85); - } - } - /* end of optional [ | ] expression */ -} - - -/* - RetryStatement := 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_retrytok, stopset0, stopset1, stopset2); -} - - -/* - AssignmentOrProcedureCall := Designator ( ':=' Expression | - ActualParameters | - - % epsilon % - ) - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Designator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_becomestok) - { - Expect (mcReserved_becomestok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ActualParameters (stopset0, stopset1, stopset2); - } - /* epsilon */ -} - - -/* - StatementSequence := Statement { ';' Statement } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Statement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Statement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - IfStatement := 'IF' Expression 'THEN' StatementSequence - { 'ELSIF' Expression 'THEN' StatementSequence } - [ 'ELSE' StatementSequence ] 'END' - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_iftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - Expect (mcReserved_thentok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_elsiftok) - { - Expect (mcReserved_elsiftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - Expect (mcReserved_thentok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - CaseStatement := 'CASE' Expression 'OF' Case { '|' - Case } - CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_casetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Case (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Case (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - CaseEndStatement (stopset0, stopset1, stopset2); -} - - -/* - CaseEndStatement := 'END' | 'ELSE' StatementSequence - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_endtok) - { - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - /* avoid dangling else. */ - Expect (mcReserved_elsetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ELSE END", 26); - } -} - - -/* - Case := [ CaseLabelList ':' StatementSequence ] - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - CaseLabelList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1, stopset2); - } -} - - -/* - CaseLabelList := CaseLabels { ',' CaseLabels } - - first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - CaseLabels (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - CaseLabels (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CaseLabels := ConstExpression [ '..' ConstExpression ] - - first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - } -} - - -/* - WhileStatement := 'WHILE' Expression 'DO' StatementSequence - 'END' - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_whiletok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - RepeatStatement := 'REPEAT' StatementSequence 'UNTIL' - Expression - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_repeattok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok)))); - Expect (mcReserved_untiltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); -} - - -/* - ForStatement := 'FOR' Ident ':=' Expression 'TO' - Expression [ 'BY' ConstExpression ] - 'DO' StatementSequence 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_becomestok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_dotok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - LoopStatement := 'LOOP' StatementSequence 'END' - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_looptok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - WithStatement := 'WITH' Designator 'DO' StatementSequence - 'END' - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Designator (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - % leaveScope % - - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - ProcedureHeading (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - ProcedureBlock (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - decl_leaveScope (); -} - - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) % - - % enterScope (curproc) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_lookupSym (curident); - decl_enterScope (curproc); -} - - -/* - DefProcedureIdent := Ident - % curproc := lookupSym (curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefProcedureIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_lookupSym (curident); -} - - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42); - } - } - /* end of optional [ | ] expression */ -} - - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent [ FormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalParameters (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_builtintok) - { - Expect (mcReserved_builtintok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40); - } - } - /* end of optional [ | ] expression */ -} - - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Builtin (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefProcedureIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - DefFormalParameters (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - ProcedureBlockBody (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - InitialBlock (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2); - FinalBlock (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - InitialBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_finallytok) - { - Expect (mcReserved_finallytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)))); - FinalBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - NormalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - ExceptionalPart := StatementSequence - - first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - ConstantDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeDeclaration (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ModuleDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49); - } -} - - -/* - DefFormalParameters := '(' - % paramEnter (curproc) % - [ DefMultiFPSection ] ')' - - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - decl_paramEnter (curproc); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - DefMultiFPSection (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - decl_paramLeave (curproc); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - DefExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - DefMultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FormalParameters := '(' - % paramEnter (curproc) % - [ MultiFPSection ] ')' - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - decl_paramEnter (curproc); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - MultiFPSection (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - decl_paramLeave (curproc); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - AttributeNoReturn := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeUnused := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - ExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - MultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - NonVarFPSection (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - VarFPSection (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR identifier", 32); - } -} - - -/* - DefExtendedFP := DefOptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - DefOptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - OptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - VarFPSection := 'VAR' PushIdentList ':' FormalType - [ AttributeUnused ] - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - PushIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } -} - - -/* - NonVarFPSection := PushIdentList ':' FormalType - [ AttributeUnused ] - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - PushIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } -} - - -/* - OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ] - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - DefOptArg := '[' Ident ':' FormalType '=' ConstExpression - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - FormalType := { 'ARRAY' 'OF' } PushQualident - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_arraytok) - { - Expect (mcReserved_arraytok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - PushQualident (stopset0, stopset1, stopset2); -} - - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - Block (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); -} - - -/* - Priority := '[' ConstExpression ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_exporttok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_qualifiedtok) - { - Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok) - { - /* avoid dangling else. */ - Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - IdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50); - } - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - FromIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void FromIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - FromImport := 'FROM' Ident 'IMPORT' FromIdentList - ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FromIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - ImportModuleList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ImportModuleList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_fromtok) - { - FromImport (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_importtok) - { - /* avoid dangling else. */ - WithoutFromImport (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29); - } -} - - -/* - DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR' - string ] - Ident - % curmodule := lookupDef (curident) % - - % addCommentBody (curmodule) % - ';' - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % leaveScope % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_fortok) - { - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupDef (curident); - decl_addCommentBody (curmodule); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - decl_enterScope (curmodule); - decl_resetConstExpPos (curmodule); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Definition (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "definition module", 17); - decl_leaveScope (); -} - - -/* - PushQualident := Ident - % typeExp := push (lookupSym (curident)) % - - % IF typeExp = NIL - THEN - metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident) - END % - [ '.' - % IF NOT isDef (typeExp) - THEN - ErrorArray ('the first component of this qualident must be a definition module') - END % - Ident - % typeExp := replace (lookupInScope (typeExp, curident)) ; - IF typeExp=NIL - THEN - ErrorArray ('identifier not found in definition module') - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void PushQualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - typeExp = push (decl_lookupSym (curident)); - if (typeExp == NULL) - { - mcMetaError_metaError1 ((const char *) "the symbol {%1k} is not visible in this scope (or any other nested scope)", 73, (const unsigned char *) &curident, (sizeof (curident)-1)); - } - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (! (decl_isDef (typeExp))) - { - ErrorArray ((const char *) "the first component of this qualident must be a definition module", 65); - } - Ident (stopset0, stopset1, stopset2); - typeExp = replace (decl_lookupInScope (typeExp, curident)); - if (typeExp == NULL) - { - ErrorArray ((const char *) "identifier not found in definition module", 41); - } - } -} - - -/* - OptSubrange := [ SubrangeType ] - - first symbols:lsbratok - - reachend -*/ - -static void OptSubrange (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - SubrangeType (stopset0, stopset1, stopset2); - } -} - - -/* - TypeEquiv := PushQualident OptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void TypeEquiv (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - PushQualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - OptSubrange (stopset0, stopset1, stopset2); -} - - -/* - EnumIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void EnumIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Enumeration := '(' EnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - EnumIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - SimpleType := TypeEquiv | Enumeration | - SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeEquiv (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Enumeration (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - SubrangeType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: [ ( identifier", 32); - } -} - - -/* - Type := SimpleType | ArrayType | RecordType | - SetType | PointerType | ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void Type (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - SimpleType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_arraytok) - { - /* avoid dangling else. */ - ArrayType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_recordtok) - { - /* avoid dangling else. */ - RecordType (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok)) - { - /* avoid dangling else. */ - SetType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_pointertok) - { - /* avoid dangling else. */ - PointerType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80); - } -} - - -/* - TypeDeclaration := { Ident ( ';' | '=' Type Alignment - ';' ) } - - first symbols:identtok - - reachend -*/ - -static void TypeDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: = ;", 21); - } - } - /* while */ -} - - -/* - DefQualident := Ident - % typeExp := lookupSym (curident) % - [ '.' - % IF NOT isDef (typeExp) - THEN - ErrorArray ('the first component of this qualident must be a definition module') - END % - Ident - % typeExp := lookupInScope (typeExp, curident) ; - IF typeExp=NIL - THEN - ErrorArray ('identifier not found in definition module') - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void DefQualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - typeExp = decl_lookupSym (curident); - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (! (decl_isDef (typeExp))) - { - ErrorArray ((const char *) "the first component of this qualident must be a definition module", 65); - } - Ident (stopset0, stopset1, stopset2); - typeExp = decl_lookupInScope (typeExp, curident); - if (typeExp == NULL) - { - ErrorArray ((const char *) "identifier not found in definition module", 41); - } - } -} - - -/* - DefTypeEquiv := DefQualident OptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void DefTypeEquiv (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - DefQualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - OptSubrange (stopset0, stopset1, stopset2); -} - - -/* - DefEnumIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void DefEnumIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - DefEnumeration := '(' DefEnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void DefEnumeration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefEnumIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - DefSimpleType := DefTypeEquiv | DefEnumeration | - SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void DefSimpleType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - DefTypeEquiv (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - DefEnumeration (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - SubrangeType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: [ ( identifier", 32); - } -} - - -/* - DefType := DefSimpleType | ArrayType | - RecordType | SetType | PointerType | - ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void DefType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - DefSimpleType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_arraytok) - { - /* avoid dangling else. */ - ArrayType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_recordtok) - { - /* avoid dangling else. */ - RecordType (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok)) - { - /* avoid dangling else. */ - SetType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_pointertok) - { - /* avoid dangling else. */ - PointerType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80); - } -} - - -/* - DefTypeDeclaration := { Ident ( ';' | '=' DefType - Alignment ';' ) } - - first symbols:identtok - - reachend -*/ - -static void DefTypeDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: = ;", 21); - } - } - /* while */ -} - - -/* - DefConstantDeclaration := Ident '=' ConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void DefConstantDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); -} - - -/* - Definition := 'CONST' { DefConstantDeclaration ';' } | - 'TYPE' { DefTypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - DefConstantDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - DefTypeDeclaration (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - DefProcedureHeading (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42); - } -} - - -/* - AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_asmtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_volatiletok) - { - Expect (mcReserved_volatiletok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmOperands (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - string (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - AsmOperandSpec (stopset0, stopset1, stopset2); - } -} - - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - TrashList (stopset0, stopset1, stopset2); - } - } - } -} - - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok)) - { - AsmElement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmElement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - NamedOperand (stopset0, stopset1, stopset2); - } -} - - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - AsmOperandName (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - string (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp4_CompilationUnit (void) -{ - stk = mcStack_init (); - WasNoError = TRUE; - FileUnit ((mcp4_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp4_SetOfStop1) 0, (mcp4_SetOfStop2) 0); - mcStack_kill (&stk); - return WasNoError; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcp4_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcp4_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gmcp5.c b/gcc/m2/mc-boot/Gmcp5.c deleted file mode 100644 index 9af8aac9dd51..000000000000 --- a/gcc/m2/mc-boot/Gmcp5.c +++ /dev/null @@ -1,8576 +0,0 @@ -/* do not edit automatically generated by mc from mcp5. */ -/* output from mc-5.bnf, automatically generated do not edit. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING. If not, -see . */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _mcp5_H -#define _mcp5_C - -# include "GDynamicStrings.h" -# include "GmcError.h" -# include "GnameKey.h" -# include "GmcPrintf.h" -# include "GmcDebug.h" -# include "GmcReserved.h" -# include "GmcComment.h" -# include "GmcMetaError.h" -# include "GmcStack.h" -# include "GmcLexBuf.h" -# include "Gdecl.h" - -# define Pass1 FALSE -# define Debugging FALSE -typedef unsigned int mcp5_stop0; - -typedef unsigned int mcp5_SetOfStop0; - -typedef unsigned int mcp5_stop1; - -typedef unsigned int mcp5_SetOfStop1; - -typedef unsigned int mcp5_stop2; - -typedef unsigned int mcp5_SetOfStop2; - -static unsigned int WasNoError; -static nameKey_Name curstring; -static nameKey_Name curident; -static decl_node curproc; -static decl_node frommodule; -static decl_node qualid; -static decl_node typeDes; -static decl_node typeExp; -static decl_node curmodule; -static unsigned int loopNo; -static mcStack_stack loopStk; -static mcStack_stack stmtStk; -static mcStack_stack withStk; -static mcStack_stack stk; - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp5_CompilationUnit (void); - -/* - followNode - -*/ - -static void followNode (decl_node n); - -/* - push - -*/ - -static decl_node push (decl_node n); - -/* - pop - -*/ - -static decl_node pop (void); - -/* - replace - -*/ - -static decl_node replace (decl_node n); - -/* - peep - returns the top node on the stack without removing it. -*/ - -static decl_node peep (void); - -/* - depth - returns the depth of the stack. -*/ - -static unsigned int depth (void); - -/* - checkDuplicate - -*/ - -static void checkDuplicate (unsigned int b); - -/* - isQualident - returns TRUE if, n, is a qualident. -*/ - -static unsigned int isQualident (decl_node n); - -/* - startWith - -*/ - -static void startWith (decl_node n); - -/* - endWith - -*/ - -static void endWith (void); - -/* - lookupWithSym - -*/ - -static decl_node lookupWithSym (nameKey_Name i); - -/* - pushStmt - push a node, n, to the statement stack and return node, n. -*/ - -static decl_node pushStmt (decl_node n); - -/* - popStmt - pop the top node from the statement stack. -*/ - -static decl_node popStmt (void); - -/* - peepStmt - return the top node from the statement stack, - but leave the stack unchanged. -*/ - -static decl_node peepStmt (void); - -/* - pushLoop - push a node, n, to the loop stack and return node, n. -*/ - -static decl_node pushLoop (decl_node n); - -/* - popLoop - pop the top node from the loop stack. -*/ - -static decl_node popLoop (void); - -/* - peepLoop - return the top node from the loop stack, - but leave the stack unchanged. -*/ - -static decl_node peepLoop (void); - -/* - peepLoop - return the top node from the loop stack, - but leave the stack unchanged. -*/ - -static void ErrorString (DynamicStrings_String s); - -/* - peepLoop - return the top node from the loop stack, - but leave the stack unchanged. -*/ - -static void ErrorArray (const char *a_, unsigned int _a_high); - -/* - pushNunbounded - -*/ - -static void pushNunbounded (unsigned int c); - -/* - makeIndexedArray - builds and returns an array of type, t, with, c, indices. -*/ - -static decl_node makeIndexedArray (unsigned int c, decl_node t); - -/* - importInto - from, m, import, name, into module, current. - It checks to see if curident is an enumeration type - and if so automatically includes all enumeration fields - as well. -*/ - -static void importInto (decl_node m, nameKey_Name name, decl_node current); - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high); - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void); - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t); - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t); - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - string - -*/ - -static void string (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Integer - -*/ - -static void Integer (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Real - -*/ - -static void Real (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % addCommentBody (curmodule) % - - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % leaveScope % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % addCommentBody (curmodule) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % leaveScope ; leaveScope % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstInteger := Integer - % VAR i: node ; % - - % i := pop () % - - - first symbols:integertok - - cannot reachend -*/ - -static void ConstInteger (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstReal := Real - % VAR r: node ; % - - % r := pop () % - - - first symbols:realtok - - cannot reachend -*/ - -static void ConstReal (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstNumber := ConstInteger | ConstReal - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void ConstNumber (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstantDeclaration := Ident '=' ConstExpressionNop - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstExpressionNop := - % VAR c: node ; % - - % c := getNextConstExp () % - SimpleConstExpr [ Relation - SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpressionNop (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstExpression := - % VAR c: node ; % - - % c := push (getNextConstExp ()) % - SimpleConstExpr [ Relation SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SimpleConstExpr := UnaryOrConstTerm { AddOperator - ConstTerm } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - UnaryOrConstTerm := '+' ConstTerm | - '-' ConstTerm | - ConstTerm - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstTerm := ConstFactor { MulOperator ConstFactor } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - NotConstFactor := 'NOT' ConstFactor - % VAR n: node ; % - - % n := push (makeUnaryTok (nottok, pop ())) % - - - first symbols:nottok - - cannot reachend -*/ - -static void NotConstFactor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstFactor := ConstNumber | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpressionNop ')' | - NotConstFactor | - ConstAttribute - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstComponentElement := ConstExpressionNop [ '..' - ConstExpressionNop ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstComponentElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstComponentValue := ConstComponentElement [ 'BY' - ConstExpressionNop ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstComponentValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstArraySetRecordValue := ConstComponentValue - { ',' ConstComponentValue } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstArraySetRecordValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstConstructor := '{' [ ConstArraySetRecordValue ] - '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void ConstConstructor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstSetOrQualidentOrFunction := Qualident [ ConstConstructor | - ConstActualParameters ] | - ConstConstructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstActualParameters := '(' [ ConstExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstExpList := ConstExpressionNop { ',' ConstExpressionNop } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ConstAttributeExpression := Ident | '<' Qualident - ',' Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AlignmentExpression := '(' ConstExpressionNop ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SubrangeType := '[' ConstExpressionNop '..' ConstExpressionNop - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ArrayType := 'ARRAY' SimpleType { ',' SimpleType } - 'OF' Type - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - RecordType := 'RECORD' [ DefaultRecordAttributes ] - FieldListSequence 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - PragmaConstExpression := [ '(' ConstExpressionNop - ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AttributeExpression := Ident '(' ConstExpressionNop - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FieldList := IdentList ':' Type RecordFieldPragma | - 'CASE' CaseTag 'OF' Varient { '|' Varient } - [ 'ELSE' FieldListSequence ] 'END' - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - TagIdent := Ident | - % curident := NulName % - - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - CaseTag := TagIdent [ ':' Qualident ] - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Varient := [ VarientCaseLabelList ':' FieldListSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - VarientCaseLabels := ConstExpressionNop [ '..' ConstExpressionNop ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - PointerType := 'POINTER' 'TO' Type - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureType := 'PROCEDURE' [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - OptReturnType := '[' Qualident ']' | - Qualident - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureParameters := ProcedureParameter { ',' - ProcedureParameter } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureParameter := '...' | 'VAR' FormalType | - FormalType - - first symbols:arraytok, identtok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - VarIdent := Ident [ '[' ConstExpressionNop ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - VarIdentList := VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - VariableDeclaration := VarIdentList ':' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Designator := PushQualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SubDesignator := - % VAR n, field, type: node ; % - - % n := peep () % - - % IF n = NIL - THEN - ErrorArray ('no expression found') ; - flushErrors ; - RETURN - END % - - % type := skipType (getType (n)) % - ( '.' Ident - % IF isRecord (type) - THEN - field := lookupInScope (type, curident) ; - IF field = NIL - THEN - metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type) - ELSE - n := replace (makeComponentRef (n, field)) - END - ELSE - metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type) - END % - | '[' ArrayExpList - % IF isArray (type) - THEN - n := replace (makeArrayRef (n, pop ())) - ELSE - metaError1 ('attempting to access an array but the expression is not an array but a {%1d}', type) - END % - ']' | SubPointer ) - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SubPointer := - % VAR n, field, type: node ; % - - % n := peep () % - - % type := skipType (getType (n)) % - '^' ( '.' Ident - % IF isPointer (type) - THEN - type := skipType (getType (type)) ; - IF isRecord (type) - THEN - field := lookupInScope (type, curident) ; - IF field = NIL - THEN - metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type) - ELSE - n := replace (makePointerRef (n, field)) - END - ELSE - metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type) - END - ELSE - metaError2 ('trying to dereference {%1k} which was not declared as a pointer but a {%2tad}', n, n) - END % - | - % IF isPointer (type) - THEN - n := replace (makeDeRef (n)) - ELSE - metaError1 ('attempting to dereference a pointer but the expression is not a pointer but a {%1d}', type) - END % - ) - - first symbols:uparrowtok - - cannot reachend -*/ - -static void SubPointer (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ArrayExpList := - % VAR l: node ; % - - % l := push (makeExpList ()) % - Expression - % putExpList (l, pop ()) % - - % assert (isExpList (peep ())) % - { ',' Expression - % putExpList (l, pop ()) % - - % assert (isExpList (peep ())) % - } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ExpList := - % VAR p, n: node ; % - - % p := peep () % - - % assert (isExpList (p)) % - Expression - % putExpList (p, pop ()) % - - % assert (isExpList (peep ())) % - { ',' Expression - % putExpList (p, pop ()) % - - % assert (isExpList (peep ())) % - } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Expression := - % VAR c, l, r: node ; op: toktype ; % - SimpleExpression - % op := currenttoken % - [ Relation - % l := pop () % - SimpleExpression - % r := pop () % - - % r := push (makeBinaryTok (op, l, r)) % - ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SimpleExpression := - % VAR op: toktype ; n: node ; % - UnaryOrTerm { - % op := currenttoken % - - % n := pop () % - AddOperator Term - - % n := push (makeBinaryTok (op, n, pop ())) % - } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - UnaryOrTerm := - % VAR n: node ; % - '+' Term - % n := push (makeUnaryTok (plustok, pop ())) % - | '-' Term - % n := push (makeUnaryTok (minustok, pop ())) % - | Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Term := - % VAR op: toktype ; n: node ; % - Factor { - % op := currenttoken % - MulOperator - % n := pop () % - Factor - % n := push (makeBinaryTok (op, n, pop ())) % - } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - PushString := string - % VAR n: node ; % - - % n := push (makeString (curstring)) % - - - first symbols:stringtok - - cannot reachend -*/ - -static void PushString (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Factor := Number | PushString | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor - % VAR n: node ; % - - % n := push (makeUnaryTok (nottok, pop ())) % - | ConstAttribute - % n := push (makeUnaryTok (nottok, pop ())) % - ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ComponentElement := Expression - % VAR l, h, n: node ; % - - % l := pop () % - - % h := NIL % - [ '..' Expression - % h := pop () % - - % ErrorArray ('implementation restriction range is not allowed') % - ] - % n := push (includeSetValue (pop (), l, h)) % - - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ComponentValue := ComponentElement [ 'BY' - % ErrorArray ('implementation restriction BY not allowed') % - Expression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Constructor := '{' - % VAR n: node ; % - - % n := push (makeSetValue ()) % - [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SetOrDesignatorOrFunction := PushQualident - % VAR q, p, n: node ; % - [ Constructor - % p := pop () % - - % q := pop () % - - % n := push (putSetValue (p, q)) % - | SimpleDes [ - % q := pop () % - ActualParameters - - % p := pop () % - - % p := push (makeFuncCall (q, p)) % - ] ] | - Constructor - - first symbols:identtok, lcbratok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SimpleDes := { SubDesignator } - - first symbols:uparrowtok, periodtok, lsbratok - - reachend -*/ - -static void SimpleDes (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ActualParameters := '(' - % VAR n: node ; % - - % n := push (makeExpList ()) % - [ ExpList ] ')' - % assert (isExpList (peep ())) % - - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ExitStatement := - % VAR n: node ; % - 'EXIT' - % IF loopNo = 0 - THEN - ErrorArray ('EXIT can only be used inside a LOOP statement') - ELSE - n := pushStmt (makeExit (peepLoop (), loopNo)) - END % - - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ReturnStatement := - % VAR n: node ; % - - % n := pushStmt (makeReturn ()) % - 'RETURN' [ Expression - % putReturn (n, pop ()) % - ] - % addCommentBody (peepStmt ()) % - - % addCommentAfter (peepStmt ()) % - - % assert (isReturn (peepStmt ())) % - - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Statement := ( AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement | - - % VAR s: node ; % - - % s := pushStmt (NIL) % - ) - - first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok - - reachend -*/ - -static void Statement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - RetryStatement := - % VAR s: node ; % - - % s := pushStmt (makeComment ("retry")) % - 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AssignmentOrProcedureCall := - % VAR d, a, p: node ; % - Designator - % d := pop () % - ( ':=' Expression - % a := pushStmt (makeAssignment (d, pop ())) % - | - ActualParameters - - % a := pushStmt (makeFuncCall (d, pop ())) % - | - - % a := pushStmt (makeFuncCall (d, NIL)) % - ) - % addCommentBody (peepStmt ()) % - - % addCommentAfter (peepStmt ()) % - - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - StatementSequence := - % VAR s, t: node ; % - - % s := pushStmt (makeStatementSequence ()) % - - % assert (isStatementSequence (peepStmt ())) % - Statement - % addStatement (s, popStmt ()) % - - % assert (isStatementSequence (peepStmt ())) % - { ';' Statement - % addStatement (s, popStmt ()) % - - % assert (isStatementSequence (peepStmt ())) % - } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - IfStatement := - % VAR i, a, b: node ; % - 'IF' - % b := makeCommentS (getBodyComment ()) % - Expression - % a := makeCommentS (getAfterComment ()) % - 'THEN' StatementSequence - % i := pushStmt (makeIf (pop (), popStmt ())) % - - % addIfComments (i, b, a) % - { 'ELSIF' - % b := makeCommentS (getBodyComment ()) % - Expression - % a := makeCommentS (getAfterComment ()) % - 'THEN' - % addElseComments (peepStmt (), b, a) % - StatementSequence - % i := makeElsif (i, pop (), popStmt ()) % - } [ 'ELSE' StatementSequence - % putElse (i, popStmt ()) % - ] 'END' - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % assert (isIf (peepStmt ())) % - - % addIfEndComments (peepStmt (), b, a) % - - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - CaseStatement := - % VAR s, e: node ; % - - % s := pushStmt (makeCase ()) % - 'CASE' Expression - % s := putCaseExpression (s, pop ()) % - 'OF' Case { '|' Case } CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - CaseEndStatement := - % VAR c: node ; % - 'END' | 'ELSE' - % c := peepStmt () % - StatementSequence - % c := putCaseElse (c, popStmt ()) % - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Case := [ CaseLabelList ':' - % VAR l, c: node ; % - - % l := pop () % - - % c := peepStmt () % - StatementSequence - % c := putCaseStatement (c, l, popStmt ()) % - ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - CaseLabelList := - % VAR l: node ; % - - % l := push (makeCaseList ()) % - CaseLabels { ',' CaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - CaseLabels := - % VAR lo, hi, l: node ; % - - % lo := NIL ; hi := NIL % - - % l := peep () % - ConstExpression - % lo := pop () % - [ '..' ConstExpression - % hi := pop () % - ] - % l := putCaseRange (l, lo, hi) % - - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - WhileStatement := - % VAR s, w, e, a, b: node ; % - - % w := pushStmt (makeWhile ()) % - 'WHILE' Expression 'DO' - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % addWhileDoComment (w, b, a) % - - % e := pop () % - StatementSequence - % s := popStmt () % - 'END' - % assert (isStatementSequence (peepStmt ())) % - - % putWhile (w, e, s) % - - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % addWhileEndComment (w, b, a) % - - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - RepeatStatement := - % VAR r, s, a, b: node ; % - - % r := pushStmt (makeRepeat ()) % - 'REPEAT' - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % addRepeatComment (r, b, a) % - StatementSequence - % s := popStmt () % - 'UNTIL' Expression - % putRepeat (r, s, pop ()) % - - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % addUntilComment (r, b, a) % - - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ForStatement := - % VAR f, i, s, e, b: node ; % - - % b := NIL % - - % f := pushStmt (makeFor ()) % - 'FOR' Ident - % i := lookupWithSym (curident) % - ':=' Expression - % s := pop () % - 'TO' Expression - % e := pop () % - [ 'BY' ConstExpression - % b := pop () % - ] 'DO' StatementSequence - % putFor (f, i, s, e, b, popStmt ()) % - 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - LoopStatement := - % VAR l, s: node ; % - 'LOOP' - % l := pushStmt (pushLoop (makeLoop ())) % - - % INC (loopNo) % - StatementSequence - % s := popStmt () % - - % putLoop (l, s) % - - % DEC (loopNo) % - 'END' - % l := popLoop () % - - % assert (isLoop (peepStmt ())) % - - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - WithStatement := 'WITH' Designator 'DO' - % startWith (pop ()) % - StatementSequence 'END' - % endWith % - - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - % leaveScope % - - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) % - - % enterScope (curproc) % - - % setProcedureComment (lastcomment, curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefProcedureIdent := Ident - % curproc := lookupSym (curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefProcedureIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent [ FormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - InitialBlockBody := NormalPart - % putBegin (curmodule, popStmt ()) % - [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FinalBlockBody := NormalPart - % putFinally (curmodule, popStmt ()) % - [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureBlockBody := ProcedureNormalPart [ 'EXCEPT' - ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ProcedureNormalPart := StatementSequence - % putBegin (curproc, popStmt ()) % - - - first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok - - reachend -*/ - -static void ProcedureNormalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - NormalPart := StatementSequence - - first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ExceptionalPart := StatementSequence - - first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefFormalParameters := '(' - % paramEnter (curproc) % - [ DefMultiFPSection ] ')' - - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AttributeNoReturn := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AttributeUnused := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FormalParameters := '(' - % paramEnter (curproc) % - [ MultiFPSection ] ')' - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefExtendedFP := DefOptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - VarFPSection := 'VAR' IdentList ':' FormalType [ - AttributeUnused ] - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ] - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - OptArg := '[' Ident ':' FormalType [ '=' ConstExpressionNop ] - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefOptArg := '[' Ident ':' FormalType '=' ConstExpressionNop - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FormalType := { 'ARRAY' 'OF' } Qualident - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Priority := '[' ConstExpressionNop ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FromIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void FromIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - FromImport := 'FROM' Ident 'IMPORT' FromIdentList - ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - ImportModuleList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR' - string ] - Ident ';' - % curmodule := lookupDef (curident) % - - % enterScope (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % leaveScope % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - PushQualident := - % VAR type, field: node ; % - Ident - % qualid := push (lookupWithSym (curident)) % - - % IF qualid = NIL - THEN - metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident) - END % - [ '.' - % IF NOT isQualident (qualid) - THEN - ErrorArray ('the first component of this qualident must be a definition module or a parameter/variable/constant which has record type') - END % - Ident - % IF isDef (qualid) - THEN - qualid := replace (lookupInScope (qualid, curident)) - ELSE - type := skipType (getType (qualid)) ; - field := lookupInScope (type, curident) ; - IF field = NIL - THEN - metaError2 ('field {%1k} cannot be found in {%2ad}', curident, qualid) - ELSE - qualid := replace (makeComponentRef (qualid, field)) - END - END ; - IF qualid = NIL - THEN - metaError1 ('qualified component of the identifier {%1k} cannot be found', curident) - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void PushQualident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - OptSubrange := [ SubrangeType ] - - first symbols:lsbratok - - reachend -*/ - -static void OptSubrange (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - TypeEquiv := Qualident OptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void TypeEquiv (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - EnumIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void EnumIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Enumeration := '(' EnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - SimpleType := TypeEquiv | Enumeration | - SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Type := SimpleType | ArrayType | RecordType | - SetType | PointerType | ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void Type (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - TypeDeclaration := { Ident ( ';' | '=' Type Alignment - ';' ) } - - first symbols:identtok - - reachend -*/ - -static void TypeDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - Definition := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AsmStatement := - % VAR s: node ; % - - % s := pushStmt (makeComment ("asm")) % - 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2); - - -/* - followNode - -*/ - -static void followNode (decl_node n) -{ - if (decl_isVar (n)) - { - mcPrintf_printf0 ((const char *) "variable: ", 10); - } - else if (decl_isParameter (n)) - { - /* avoid dangling else. */ - mcPrintf_printf0 ((const char *) "parameter: ", 11); - } - n = decl_skipType (decl_getType (n)); - if (decl_isArray (n)) - { - mcPrintf_printf0 ((const char *) "array\\n", 7); - } - else if (decl_isPointer (n)) - { - /* avoid dangling else. */ - mcPrintf_printf0 ((const char *) "pointer\\n", 9); - } - else if (decl_isRecord (n)) - { - /* avoid dangling else. */ - mcPrintf_printf0 ((const char *) "record\\n", 8); - } - else - { - /* avoid dangling else. */ - mcPrintf_printf0 ((const char *) "other\\n", 7); - } -} - - -/* - push - -*/ - -static decl_node push (decl_node n) -{ - return static_cast (mcStack_push (stk, reinterpret_cast (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - pop - -*/ - -static decl_node pop (void) -{ - return static_cast (mcStack_pop (stk)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - replace - -*/ - -static decl_node replace (decl_node n) -{ - return static_cast (mcStack_replace (stk, reinterpret_cast (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - peep - returns the top node on the stack without removing it. -*/ - -static decl_node peep (void) -{ - return push (pop ()); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - depth - returns the depth of the stack. -*/ - -static unsigned int depth (void) -{ - return mcStack_depth (stk); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - checkDuplicate - -*/ - -static void checkDuplicate (unsigned int b) -{ -} - - -/* - isQualident - returns TRUE if, n, is a qualident. -*/ - -static unsigned int isQualident (decl_node n) -{ - decl_node type; - - if (decl_isDef (n)) - { - return TRUE; - } - else - { - type = decl_skipType (decl_getType (n)); - return (type != NULL) && (decl_isRecord (type)); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - startWith - -*/ - -static void startWith (decl_node n) -{ - n = static_cast (mcStack_push (withStk, reinterpret_cast (n))); -} - - -/* - endWith - -*/ - -static void endWith (void) -{ - decl_node n; - - n = static_cast (mcStack_pop (withStk)); -} - - -/* - lookupWithSym - -*/ - -static decl_node lookupWithSym (nameKey_Name i) -{ - unsigned int d; - decl_node n; - decl_node m; - decl_node t; - - d = mcStack_depth (withStk); - while (d != 0) - { - n = static_cast (mcStack_access (withStk, d)); - t = decl_skipType (decl_getType (n)); - m = decl_lookupInScope (t, i); - if (m != NULL) - { - n = decl_dupExpr (n); - return decl_makeComponentRef (n, m); - } - d -= 1; - } - return decl_lookupSym (i); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - pushStmt - push a node, n, to the statement stack and return node, n. -*/ - -static decl_node pushStmt (decl_node n) -{ - return static_cast (mcStack_push (stmtStk, reinterpret_cast (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - popStmt - pop the top node from the statement stack. -*/ - -static decl_node popStmt (void) -{ - return static_cast (mcStack_pop (stmtStk)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - peepStmt - return the top node from the statement stack, - but leave the stack unchanged. -*/ - -static decl_node peepStmt (void) -{ - return pushStmt (popStmt ()); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - pushLoop - push a node, n, to the loop stack and return node, n. -*/ - -static decl_node pushLoop (decl_node n) -{ - return static_cast (mcStack_push (loopStk, reinterpret_cast (n))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - popLoop - pop the top node from the loop stack. -*/ - -static decl_node popLoop (void) -{ - return static_cast (mcStack_pop (loopStk)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - peepLoop - return the top node from the loop stack, - but leave the stack unchanged. -*/ - -static decl_node peepLoop (void) -{ - return pushLoop (popLoop ()); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - peepLoop - return the top node from the loop stack, - but leave the stack unchanged. -*/ - -static void ErrorString (DynamicStrings_String s) -{ - mcError_errorStringAt (s, mcLexBuf_getTokenNo ()); - WasNoError = FALSE; -} - - -/* - peepLoop - return the top node from the loop stack, - but leave the stack unchanged. -*/ - -static void ErrorArray (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - ErrorString (DynamicStrings_InitString ((const char *) a, _a_high)); -} - - -/* - pushNunbounded - -*/ - -static void pushNunbounded (unsigned int c) -{ - decl_node type; - decl_node array; - decl_node subrange; - - while (c != 0) - { - type = pop (); - subrange = decl_makeSubrange (static_cast (NULL), static_cast (NULL)); - decl_putSubrangeType (subrange, decl_getCardinal ()); - array = decl_makeArray (subrange, type); - decl_putUnbounded (array); - type = push (array); - c -= 1; - } -} - - -/* - makeIndexedArray - builds and returns an array of type, t, with, c, indices. -*/ - -static decl_node makeIndexedArray (unsigned int c, decl_node t) -{ - decl_node i; - - while (c > 0) - { - t = decl_makeArray (pop (), t); - c -= 1; - } - return t; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - importInto - from, m, import, name, into module, current. - It checks to see if curident is an enumeration type - and if so automatically includes all enumeration fields - as well. -*/ - -static void importInto (decl_node m, nameKey_Name name, decl_node current) -{ - decl_node s; - decl_node o; - - mcDebug_assert (decl_isDef (m)); - mcDebug_assert (((decl_isDef (current)) || (decl_isModule (current))) || (decl_isImp (current))); - s = decl_lookupExported (m, name); - if (s == NULL) - { - mcMetaError_metaError2 ((const char *) "{%1k} was not exported from definition module {%2a}", 51, (const unsigned char *) &name, (sizeof (name)-1), (const unsigned char *) &m, (sizeof (m)-1)); - } - else - { - o = decl_import (current, s); - if (s != o) - { - mcMetaError_metaError2 ((const char *) "{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}", 87, (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &o, (sizeof (o)-1)); - } - } -} - - -/* - checkEndName - if module does not have, name, then issue an error containing, desc. -*/ - -static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high) -{ - DynamicStrings_String s; - char desc[_desc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (desc, desc_, _desc_high+1); - - if ((decl_getSymName (module)) != name) - { - s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41); - s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high))); - ErrorString (s); - } -} - - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - unsigned int n; - DynamicStrings_String str; - DynamicStrings_String message; - - n = 0; - message = DynamicStrings_InitString ((const char *) "", 0); - if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6))); - n += 1; - } - if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11))); - n += 1; - } - if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10))); - n += 1; - } - if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14))); - n += 1; - } - if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10))); - n += 1; - } - if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11))); - n += 1; - } - if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13))); - n += 1; - } - if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3))); - n += 1; - } - if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8))); - n += 1; - } - if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3))); - n += 1; - } - if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4))); - n += 1; - } - if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5))); - n += 1; - } - if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3))); - n += 1; - } - if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5))); - n += 1; - } - if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4))); - n += 1; - } - if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2))); - n += 1; - } - if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4))); - n += 1; - } - if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3))); - n += 1; - } - if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6))); - n += 1; - } - if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5))); - n += 1; - } - if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6))); - n += 1; - } - if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3))); - n += 1; - } - if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6))); - n += 1; - } - if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11))); - n += 1; - } - if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9))); - n += 1; - } - if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9))); - n += 1; - } - if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7))); - n += 1; - } - if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9))); - n += 1; - } - if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2))); - n += 1; - } - if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2))); - n += 1; - } - if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3))); - n += 1; - } - if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6))); - n += 1; - } - if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3))); - n += 1; - } - if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4))); - n += 1; - } - if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2))); - n += 1; - } - if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14))); - n += 1; - } - if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2))); - n += 1; - } - if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4))); - n += 1; - } - if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3))); - n += 1; - } - if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7))); - n += 1; - } - if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6))); - n += 1; - } - if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4))); - n += 1; - } - if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6))); - n += 1; - } - if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3))); - n += 1; - } - if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5))); - n += 1; - } - if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4))); - n += 1; - } - if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2))); - n += 1; - } - if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3))); - n += 1; - } - if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10))); - n += 1; - } - if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5))); - n += 1; - } - if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4))); - n += 1; - } - if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2))); - n += 1; - } - if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5))); - n += 1; - } - if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5))); - n += 1; - } - if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3))); - n += 1; - } - if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2))); - n += 1; - } - if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2))); - n += 1; - } - if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2))); - n += 1; - } - if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2))); - n += 1; - } - if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2))); - n += 1; - } - if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1))); - n += 1; - } - if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1))); - n += 1; - } - if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1))); - n += 1; - } - if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1))); - n += 1; - } - if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1))); - n += 1; - } - if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))); - n += 1; - } - if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1))); - n += 1; - } - if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1))); - n += 1; - } - if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1))); - n += 1; - } - if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1))); - n += 1; - } - if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1))); - n += 1; - } - if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ','); - n += 1; - } - if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ','); - n += 1; - } - if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1))); - n += 1; - } - if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1))); - n += 1; - } - if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1))); - n += 1; - } - if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1))); - n += 1; - } - if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1))); - n += 1; - } - if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1))); - n += 1; - } - if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1))); - n += 1; - } - if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1))); - n += 1; - } - if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1))); - n += 1; - } - if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2))); - n += 1; - } - if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0)) - {} /* empty. */ - /* eoftok has no token name (needed to generate error messages) */ - if (n == 0) - { - str = DynamicStrings_InitString ((const char *) " syntax error", 13); - message = DynamicStrings_KillString (message); - } - else if (n == 1) - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9))); - } - else - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message); - message = DynamicStrings_KillString (message); - } - return str; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void) -{ - DynamicStrings_String str; - - str = DynamicStrings_InitString ((const char *) "", 0); - switch (mcLexBuf_currenttoken) - { - case mcReserved_stringtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_realtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_identtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_integertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_inlinetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_builtintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_attributetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str)); - break; - - case mcReserved_filetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_linetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_datetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_volatiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str)); - break; - - case mcReserved_asmtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_withtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_whiletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_vartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_untiltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_typetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_totok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_thentok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_settok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_returntok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_retrytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_repeattok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_remtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_recordtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_unqualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str)); - break; - - case mcReserved_qualifiedtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_proceduretok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_pointertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_packedsettok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str)); - break; - - case mcReserved_ortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_oftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_nottok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_moduletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_modtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_looptok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_intok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_importtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_implementationtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str)); - break; - - case mcReserved_iftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_fromtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_fortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_finallytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str)); - break; - - case mcReserved_exporttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_exittok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_excepttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str)); - break; - - case mcReserved_endtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsiftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_elsetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_dotok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_divtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_definitiontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str)); - break; - - case mcReserved_consttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_casetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str)); - break; - - case mcReserved_bytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_begintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_arraytok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str)); - break; - - case mcReserved_andtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str)); - break; - - case mcReserved_colontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodperiodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_rdirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_ldirectivetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_greaterequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessequaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_lessgreatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_hashtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_equaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_uparrowtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_semicolontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_commatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_periodtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_ambersandtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_dividetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_timestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_minustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_plustok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_doublequotestok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str)); - break; - - case mcReserved_singlequotetok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str)); - break; - - case mcReserved_greatertok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lesstok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lcbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_rsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_lsbratok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_bartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str)); - break; - - case mcReserved_becomestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str)); - break; - - case mcReserved_eoftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str)); - break; - - - default: - break; - } - ErrorString (str); -} - - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - DescribeError (); - if (Debugging) - { - mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21); - } - /* - yes the ORD(currenttoken) looks ugly, but it is *much* safer than - using currenttoken= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - mcLexBuf_getToken (); - } - if (Debugging) - { - mcPrintf_printf0 ((const char *) " ***\\n", 6); - } -} - - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) - { - SyntaxError (stopset0, stopset1, stopset2); - } -} - - -/* - WarnMissingToken - generates a warning message about a missing token, t. -*/ - -static void WarnMissingToken (mcReserved_toktype t) -{ - mcp5_SetOfStop0 s0; - mcp5_SetOfStop1 s1; - mcp5_SetOfStop2 s2; - DynamicStrings_String str; - - s0 = (mcp5_SetOfStop0) 0; - s1 = (mcp5_SetOfStop1) 0; - s2 = (mcp5_SetOfStop2) 0; - if ( ((unsigned int) (t)) < 32) - { - s0 = (mcp5_SetOfStop0) ((1 << (t-mcReserved_eoftok))); - } - else if ( ((unsigned int) (t)) < 64) - { - /* avoid dangling else. */ - s1 = (mcp5_SetOfStop1) ((1 << (t-mcReserved_arraytok))); - } - else - { - /* avoid dangling else. */ - s2 = (mcp5_SetOfStop2) ((1 << (t-mcReserved_recordtok))); - } - str = DescribeStop (s0, s1, s2); - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str)); - mcError_errorStringAt (str, mcLexBuf_getTokenNo ()); -} - - -/* - MissingToken - generates a warning message about a missing token, t. -*/ - -static void MissingToken (mcReserved_toktype t) -{ - WarnMissingToken (t); - if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok)) - { - if (Debugging) - { - mcPrintf_printf0 ((const char *) "inserting token\\n", 17); - } - mcLexBuf_insertToken (t); - } -} - - -/* - CheckAndInsert - -*/ - -static unsigned int CheckAndInsert (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - WarnMissingToken (t); - mcLexBuf_insertTokenAndRewind (t); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InStopSet -*/ - -static unsigned int InStopSet (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0)))) - { - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken - If it is not then it will insert a token providing the token - is one of ; ] ) } . OF END , - - if the stopset contains then we do not insert a token -*/ - -static void PeepToken (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - /* and again (see above re: ORD) - */ - if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2)))) - { - /* SyntaxCheck would fail since currentoken is not part of the stopset - we check to see whether any of currenttoken might be a commonly omitted token */ - if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2))) - {} /* empty. */ - } -} - - -/* - Expect - -*/ - -static void Expect (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == t) - { - /* avoid dangling else. */ - mcLexBuf_getToken (); - if (Pass1) - { - PeepToken (stopset0, stopset1, stopset2); - } - } - else - { - MissingToken (t); - } - SyntaxCheck (stopset0, stopset1, stopset2); -} - - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - curident = nameKey_makekey (mcLexBuf_currentstring); - Expect (mcReserved_identtok, stopset0, stopset1, stopset2); -} - - -/* - string - -*/ - -static void string (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - curstring = nameKey_makekey (mcLexBuf_currentstring); - Expect (mcReserved_stringtok, stopset0, stopset1, stopset2); -} - - -/* - Integer - -*/ - -static void Integer (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - n = push (decl_makeLiteralInt (nameKey_makekey (mcLexBuf_currentstring))); - Expect (mcReserved_integertok, stopset0, stopset1, stopset2); -} - - -/* - Real - -*/ - -static void Real (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - n = push (decl_makeLiteralReal (nameKey_makekey (mcLexBuf_currentstring))); - Expect (mcReserved_realtok, stopset0, stopset1, stopset2); -} - - -/* - FileUnit := DefinitionModule | - ImplementationOrProgramModule - - first symbols:implementationtok, moduletok, definitiontok - - cannot reachend -*/ - -static void FileUnit (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_definitiontok) - { - DefinitionModule (stopset0, stopset1, stopset2); - } - else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) - { - /* avoid dangling else. */ - ImplementationOrProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50); - } -} - - -/* - ProgramModule := 'MODULE' Ident - % curmodule := lookupModule (curident) % - - % addCommentBody (curmodule) % - - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - [ Priority ] ';' { Import } Block - Ident - % checkEndName (curmodule, curident, 'program module') % - - % leaveScope % - '.' - - first symbols:moduletok - - cannot reachend -*/ - -static void ProgramModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupModule (curident); - decl_addCommentBody (curmodule); - decl_enterScope (curmodule); - decl_resetConstExpPos (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "program module", 14); - decl_leaveScope (); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationModule := 'IMPLEMENTATION' 'MODULE' - Ident - % curmodule := lookupImp (curident) % - - % addCommentBody (curmodule) % - - % enterScope (lookupDef (curident)) % - - % enterScope (curmodule) % - - % resetConstExpPos (curmodule) % - [ Priority ] ';' { Import } - Block Ident - % checkEndName (curmodule, curident, 'implementation module') % - - % leaveScope ; leaveScope % - '.' - - first symbols:implementationtok - - cannot reachend -*/ - -static void ImplementationModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - curmodule = decl_lookupImp (curident); - decl_addCommentBody (curmodule); - decl_enterScope (decl_lookupDef (curident)); - decl_enterScope (curmodule); - decl_resetConstExpPos (curmodule); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - Block (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "implementation module", 21); - decl_leaveScope (); - decl_leaveScope (); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); -} - - -/* - ImplementationOrProgramModule := ImplementationModule | - ProgramModule - - first symbols:moduletok, implementationtok - - cannot reachend -*/ - -static void ImplementationOrProgramModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_implementationtok) - { - ImplementationModule (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ProgramModule (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39); - } -} - - -/* - ConstInteger := Integer - % VAR i: node ; % - - % i := pop () % - - - first symbols:integertok - - cannot reachend -*/ - -static void ConstInteger (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node i; - - Integer (stopset0, stopset1, stopset2); - i = pop (); -} - - -/* - ConstReal := Real - % VAR r: node ; % - - % r := pop () % - - - first symbols:realtok - - cannot reachend -*/ - -static void ConstReal (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node r; - - Real (stopset0, stopset1, stopset2); - r = pop (); -} - - -/* - ConstNumber := ConstInteger | ConstReal - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void ConstNumber (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_integertok) - { - ConstInteger (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_realtok) - { - /* avoid dangling else. */ - ConstReal (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: real number integer number", 44); - } -} - - -/* - Number := Integer | Real - - first symbols:realtok, integertok - - cannot reachend -*/ - -static void Number (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_integertok) - { - Integer (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_realtok) - { - /* avoid dangling else. */ - Real (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: real number integer number", 44); - } -} - - -/* - Qualident := Ident { '.' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void Qualident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstantDeclaration := Ident '=' ConstExpressionNop - - first symbols:identtok - - cannot reachend -*/ - -static void ConstantDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_equaltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0, stopset1, stopset2); -} - - -/* - ConstExpressionNop := - % VAR c: node ; % - - % c := getNextConstExp () % - SimpleConstExpr [ Relation - SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpressionNop (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node c; - - c = decl_getNextConstExp (); - SimpleConstExpr (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SimpleConstExpr (stopset0, stopset1, stopset2); - } -} - - -/* - ConstExpression := - % VAR c: node ; % - - % c := push (getNextConstExp ()) % - SimpleConstExpr [ Relation SimpleConstExpr ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node c; - - c = push (decl_getNextConstExp ()); - SimpleConstExpr (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - SimpleConstExpr (stopset0, stopset1, stopset2); - } -} - - -/* - Relation := '=' | '#' | '<>' | '<' | '<=' | - '>' | '>=' | 'IN' - - first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok - - cannot reachend -*/ - -static void Relation (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_hashtok) - { - /* avoid dangling else. */ - Expect (mcReserved_hashtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lessequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greatertok) - { - /* avoid dangling else. */ - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_intok) - { - /* avoid dangling else. */ - Expect (mcReserved_intok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37); - } -} - - -/* - SimpleConstExpr := UnaryOrConstTerm { AddOperator - ConstTerm } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleConstExpr (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - UnaryOrConstTerm (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - AddOperator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - } - /* while */ -} - - -/* - UnaryOrConstTerm := '+' ConstTerm | - '-' ConstTerm | - ConstTerm - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrConstTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - ConstTerm (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ConstTerm (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ identifier { string - +", 88); - } -} - - -/* - AddOperator := '+' | '-' | 'OR' - - first symbols:ortok, minustok, plustok - - cannot reachend -*/ - -static void AddOperator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ortok) - { - /* avoid dangling else. */ - Expect (mcReserved_ortok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: OR - +", 24); - } -} - - -/* - ConstTerm := ConstFactor { MulOperator ConstFactor } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok - - cannot reachend -*/ - -static void ConstTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ConstFactor (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - MulOperator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstFactor (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - } - /* while */ -} - - -/* - MulOperator := '*' | '/' | 'DIV' | 'MOD' | - 'REM' | 'AND' | '&' - - first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok - - cannot reachend -*/ - -static void MulOperator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_timestok) - { - Expect (mcReserved_timestok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_dividetok) - { - /* avoid dangling else. */ - Expect (mcReserved_dividetok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_divtok) - { - /* avoid dangling else. */ - Expect (mcReserved_divtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_modtok) - { - /* avoid dangling else. */ - Expect (mcReserved_modtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_remtok) - { - /* avoid dangling else. */ - Expect (mcReserved_remtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_andtok) - { - /* avoid dangling else. */ - Expect (mcReserved_andtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_ambersandtok) - { - /* avoid dangling else. */ - Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39); - } -} - - -/* - NotConstFactor := 'NOT' ConstFactor - % VAR n: node ; % - - % n := push (makeUnaryTok (nottok, pop ())) % - - - first symbols:nottok - - cannot reachend -*/ - -static void NotConstFactor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_nottok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstFactor (stopset0, stopset1, stopset2); - n = push (decl_makeUnaryTok (mcReserved_nottok, pop ())); -} - - -/* - ConstFactor := ConstNumber | ConstString | - ConstSetOrQualidentOrFunction | - '(' ConstExpressionNop ')' | - NotConstFactor | - ConstAttribute - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok - - cannot reachend -*/ - -static void ConstFactor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - ConstNumber (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - ConstString (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - NotConstFactor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( identifier { string integer number real number", 84); - } -} - - -/* - ConstString := string - - first symbols:stringtok - - cannot reachend -*/ - -static void ConstString (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - string (stopset0, stopset1, stopset2); -} - - -/* - ConstComponentElement := ConstExpressionNop [ '..' - ConstExpressionNop ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstComponentElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0, stopset1, stopset2); - } -} - - -/* - ConstComponentValue := ConstComponentElement [ 'BY' - ConstExpressionNop ] - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ConstComponentValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ConstComponentElement (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0, stopset1, stopset2); - } -} - - -/* - ConstArraySetRecordValue := ConstComponentValue - { ',' ConstComponentValue } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstArraySetRecordValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ConstComponentValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstComponentValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstConstructor := '{' [ ConstArraySetRecordValue ] - '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void ConstConstructor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lcbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - ConstArraySetRecordValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - ConstSetOrQualidentOrFunction := Qualident [ ConstConstructor | - ConstActualParameters ] | - ConstConstructor - - first symbols:lcbratok, identtok - - cannot reachend -*/ - -static void ConstSetOrQualidentOrFunction (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - ConstConstructor (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ConstActualParameters (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( {", 21); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - ConstConstructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - ConstActualParameters := '(' [ ConstExpList ] ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void ConstActualParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0)))) - { - ConstExpList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ConstExpList := ConstExpressionNop { ',' ConstExpressionNop } - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ConstExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' ConstAttributeExpression - ')' ')' - - first symbols:attributetok - - cannot reachend -*/ - -static void ConstAttribute (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ConstAttributeExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - ConstAttributeExpression := Ident | '<' Qualident - ',' Ident '>' - - first symbols:lesstok, identtok - - cannot reachend -*/ - -static void ConstAttributeExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lesstok) - { - /* avoid dangling else. */ - Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_greatertok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: < identifier", 30); - } -} - - -/* - ByteAlignment := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void ByteAlignment (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - OptAlignmentExpression := [ AlignmentExpression ] - - first symbols:lparatok - - reachend -*/ - -static void OptAlignmentExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - AlignmentExpression (stopset0, stopset1, stopset2); - } -} - - -/* - AlignmentExpression := '(' ConstExpressionNop ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void AlignmentExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - Alignment := [ ByteAlignment ] - - first symbols:ldirectivetok - - reachend -*/ - -static void Alignment (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - ByteAlignment (stopset0, stopset1, stopset2); - } -} - - -/* - IdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void IdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SubrangeType := '[' ConstExpressionNop '..' ConstExpressionNop - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void SubrangeType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - ArrayType := 'ARRAY' SimpleType { ',' SimpleType } - 'OF' Type - - first symbols:arraytok - - cannot reachend -*/ - -static void ArrayType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_arraytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - /* while */ - Expect (mcReserved_oftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); -} - - -/* - RecordType := 'RECORD' [ DefaultRecordAttributes ] - FieldListSequence 'END' - - first symbols:recordtok - - cannot reachend -*/ - -static void RecordType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_recordtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - DefaultRecordAttributes (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - FieldListSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - DefaultRecordAttributes := '' - - first symbols:ldirectivetok - - cannot reachend -*/ - -static void DefaultRecordAttributes (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - AttributeExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); -} - - -/* - RecordFieldPragma := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void RecordFieldPragma (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldPragmaExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - FieldPragmaExpression := Ident PragmaConstExpression - - first symbols:identtok - - cannot reachend -*/ - -static void FieldPragmaExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - PragmaConstExpression (stopset0, stopset1, stopset2); -} - - -/* - PragmaConstExpression := [ '(' ConstExpressionNop - ')' ] - - first symbols:lparatok - - reachend -*/ - -static void PragmaConstExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeExpression := Ident '(' ConstExpressionNop - ')' - - first symbols:identtok - - cannot reachend -*/ - -static void AttributeExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - FieldListSequence := FieldListStatement { ';' FieldListStatement } - - first symbols:casetok, identtok, semicolontok - - reachend -*/ - -static void FieldListSequence (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - FieldListStatement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListStatement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - FieldListStatement := [ FieldList ] - - first symbols:identtok, casetok - - reachend -*/ - -static void FieldListStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - FieldList (stopset0, stopset1, stopset2); - } -} - - -/* - FieldList := IdentList ':' Type RecordFieldPragma | - 'CASE' CaseTag 'OF' Varient { '|' Varient } - [ 'ELSE' FieldListSequence ] 'END' - - first symbols:casetok, identtok - - cannot reachend -*/ - -static void FieldList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - RecordFieldPragma (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - Expect (mcReserved_casetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - CaseTag (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Varient (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Varient (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: CASE identifier", 33); - } -} - - -/* - TagIdent := Ident | - % curident := NulName % - - - first symbols:identtok - - reachend -*/ - -static void TagIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0, stopset1, stopset2); - } - else - { - curident = nameKey_NulName; - } -} - - -/* - CaseTag := TagIdent [ ':' Qualident ] - - first symbols:colontok, identtok - - reachend -*/ - -static void CaseTag (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - TagIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0, stopset1, stopset2); - } -} - - -/* - Varient := [ VarientCaseLabelList ':' FieldListSequence ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Varient (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))) - { - VarientCaseLabelList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FieldListSequence (stopset0, stopset1, stopset2); - } -} - - -/* - VarientCaseLabelList := VarientCaseLabels { ',' - VarientCaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void VarientCaseLabelList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - VarientCaseLabels (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - VarientCaseLabels (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VarientCaseLabels := ConstExpressionNop [ '..' ConstExpressionNop ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void VarientCaseLabels (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0, stopset1, stopset2); - } -} - - -/* - SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType - - first symbols:oftok, packedsettok, settok - - cannot reachend -*/ - -static void SetType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_settok) - { - Expect (mcReserved_settok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_packedsettok) - { - /* avoid dangling else. */ - Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31); - } - Expect (mcReserved_oftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - SimpleType (stopset0, stopset1, stopset2); -} - - -/* - PointerType := 'POINTER' 'TO' Type - - first symbols:pointertok - - cannot reachend -*/ - -static void PointerType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - Expect (mcReserved_totok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0, stopset1, stopset2); -} - - -/* - ProcedureType := 'PROCEDURE' [ FormalTypeList ] - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalTypeList (stopset0, stopset1, stopset2); - } -} - - -/* - FormalTypeList := '(' ( ')' FormalReturn | - ProcedureParameters ')' - FormalReturn ) - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalTypeList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_rparatok) - { - Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - ProcedureParameters (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - FormalReturn (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44); - } -} - - -/* - FormalReturn := [ ':' OptReturnType ] - - first symbols:colontok - - reachend -*/ - -static void FormalReturn (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - OptReturnType (stopset0, stopset1, stopset2); - } -} - - -/* - OptReturnType := '[' Qualident ']' | - Qualident - - first symbols:identtok, lsbratok - - cannot reachend -*/ - -static void OptReturnType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Qualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - Qualident (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier [", 30); - } -} - - -/* - ProcedureParameters := ProcedureParameter { ',' - ProcedureParameter } - - first symbols:identtok, arraytok, periodperiodperiodtok, vartok - - cannot reachend -*/ - -static void ProcedureParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ProcedureParameter (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureParameter (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ProcedureParameter := '...' | 'VAR' FormalType | - FormalType - - first symbols:arraytok, identtok, vartok, periodperiodperiodtok - - cannot reachend -*/ - -static void ProcedureParameter (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - FormalType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42); - } -} - - -/* - VarIdent := Ident [ '[' ConstExpressionNop ']' ] - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Expect (mcReserved_lsbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } -} - - -/* - VarIdentList := VarIdent { ',' VarIdent } - - first symbols:identtok - - cannot reachend -*/ - -static void VarIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - VarIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - VarIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - VariableDeclaration := VarIdentList ':' Type Alignment - - first symbols:identtok - - cannot reachend -*/ - -static void VariableDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - VarIdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0, stopset1, stopset2); -} - - -/* - Designator := PushQualident { SubDesignator } - - first symbols:identtok - - cannot reachend -*/ - -static void Designator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - PushQualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - SubDesignator := - % VAR n, field, type: node ; % - - % n := peep () % - - % IF n = NIL - THEN - ErrorArray ('no expression found') ; - flushErrors ; - RETURN - END % - - % type := skipType (getType (n)) % - ( '.' Ident - % IF isRecord (type) - THEN - field := lookupInScope (type, curident) ; - IF field = NIL - THEN - metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type) - ELSE - n := replace (makeComponentRef (n, field)) - END - ELSE - metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type) - END % - | '[' ArrayExpList - % IF isArray (type) - THEN - n := replace (makeArrayRef (n, pop ())) - ELSE - metaError1 ('attempting to access an array but the expression is not an array but a {%1d}', type) - END % - ']' | SubPointer ) - - first symbols:uparrowtok, lsbratok, periodtok - - cannot reachend -*/ - -static void SubDesignator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - decl_node field; - decl_node type; - - n = peep (); - if (n == NULL) - { - ErrorArray ((const char *) "no expression found", 19); - mcError_flushErrors (); - return ; - } - type = decl_skipType (decl_getType (n)); - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - if (decl_isRecord (type)) - { - field = decl_lookupInScope (type, curident); - if (field == NULL) - { - mcMetaError_metaError2 ((const char *) "field {%1k} cannot be found in record {%2ad}", 44, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &type, (sizeof (type)-1)); - } - else - { - n = replace (decl_makeComponentRef (n, field)); - } - } - else - { - mcMetaError_metaError2 ((const char *) "attempting to access a field {%1k} from {%2ad} which does not have a record type", 80, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &type, (sizeof (type)-1)); - } - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - Expect (mcReserved_lsbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ArrayExpList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (decl_isArray (type)) - { - n = replace (decl_makeArrayRef (n, pop ())); - } - else - { - mcMetaError_metaError1 ((const char *) "attempting to access an array but the expression is not an array but a {%1d}", 76, (const unsigned char *) &type, (sizeof (type)-1)); - } - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_uparrowtok) - { - /* avoid dangling else. */ - SubPointer (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ^ [ .", 23); - } -} - - -/* - SubPointer := - % VAR n, field, type: node ; % - - % n := peep () % - - % type := skipType (getType (n)) % - '^' ( '.' Ident - % IF isPointer (type) - THEN - type := skipType (getType (type)) ; - IF isRecord (type) - THEN - field := lookupInScope (type, curident) ; - IF field = NIL - THEN - metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type) - ELSE - n := replace (makePointerRef (n, field)) - END - ELSE - metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type) - END - ELSE - metaError2 ('trying to dereference {%1k} which was not declared as a pointer but a {%2tad}', n, n) - END % - | - % IF isPointer (type) - THEN - n := replace (makeDeRef (n)) - ELSE - metaError1 ('attempting to dereference a pointer but the expression is not a pointer but a {%1d}', type) - END % - ) - - first symbols:uparrowtok - - cannot reachend -*/ - -static void SubPointer (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - decl_node field; - decl_node type; - - n = peep (); - type = decl_skipType (decl_getType (n)); - Expect (mcReserved_uparrowtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - if (decl_isPointer (type)) - { - type = decl_skipType (decl_getType (type)); - if (decl_isRecord (type)) - { - field = decl_lookupInScope (type, curident); - if (field == NULL) - { - mcMetaError_metaError2 ((const char *) "field {%1k} cannot be found in record {%2ad}", 44, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &type, (sizeof (type)-1)); - } - else - { - n = replace (decl_makePointerRef (n, field)); - } - } - else - { - mcMetaError_metaError2 ((const char *) "attempting to access a field {%1k} from {%2ad} which does not have a record type", 80, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &type, (sizeof (type)-1)); - } - } - else - { - mcMetaError_metaError2 ((const char *) "trying to dereference {%1k} which was not declared as a pointer but a {%2tad}", 77, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &n, (sizeof (n)-1)); - } - } - else - { - if (decl_isPointer (type)) - { - n = replace (decl_makeDeRef (n)); - } - else - { - mcMetaError_metaError1 ((const char *) "attempting to dereference a pointer but the expression is not a pointer but a {%1d}", 83, (const unsigned char *) &type, (sizeof (type)-1)); - } - } -} - - -/* - ArrayExpList := - % VAR l: node ; % - - % l := push (makeExpList ()) % - Expression - % putExpList (l, pop ()) % - - % assert (isExpList (peep ())) % - { ',' Expression - % putExpList (l, pop ()) % - - % assert (isExpList (peep ())) % - } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArrayExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node l; - - l = push (decl_makeExpList ()); - Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - decl_putExpList (l, pop ()); - mcDebug_assert (decl_isExpList (peep ())); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - decl_putExpList (l, pop ()); - mcDebug_assert (decl_isExpList (peep ())); - } - /* while */ -} - - -/* - ExpList := - % VAR p, n: node ; % - - % p := peep () % - - % assert (isExpList (p)) % - Expression - % putExpList (p, pop ()) % - - % assert (isExpList (peep ())) % - { ',' Expression - % putExpList (p, pop ()) % - - % assert (isExpList (peep ())) % - } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node p; - decl_node n; - - p = peep (); - mcDebug_assert (decl_isExpList (p)); - Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - decl_putExpList (p, pop ()); - mcDebug_assert (decl_isExpList (peep ())); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - decl_putExpList (p, pop ()); - mcDebug_assert (decl_isExpList (peep ())); - } - /* while */ -} - - -/* - Expression := - % VAR c, l, r: node ; op: toktype ; % - SimpleExpression - % op := currenttoken % - [ Relation - % l := pop () % - SimpleExpression - % r := pop () % - - % r := push (makeBinaryTok (op, l, r)) % - ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void Expression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node c; - decl_node l; - decl_node r; - mcReserved_toktype op; - - SimpleExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2); - op = mcLexBuf_currenttoken; - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok)) - { - Relation (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - l = pop (); - SimpleExpression (stopset0, stopset1, stopset2); - r = pop (); - r = push (decl_makeBinaryTok (op, l, r)); - } -} - - -/* - SimpleExpression := - % VAR op: toktype ; n: node ; % - UnaryOrTerm { - % op := currenttoken % - - % n := pop () % - AddOperator Term - - % n := push (makeBinaryTok (op, n, pop ())) % - } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void SimpleExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - mcReserved_toktype op; - decl_node n; - - UnaryOrTerm (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok)) - { - op = mcLexBuf_currenttoken; - n = pop (); - AddOperator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2); - n = push (decl_makeBinaryTok (op, n, pop ())); - } - /* while */ -} - - -/* - UnaryOrTerm := - % VAR n: node ; % - '+' Term - % n := push (makeUnaryTok (plustok, pop ())) % - | '-' Term - % n := push (makeUnaryTok (minustok, pop ())) % - | Term - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void UnaryOrTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - if (mcLexBuf_currenttoken == mcReserved_plustok) - { - Expect (mcReserved_plustok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - n = push (decl_makeUnaryTok (mcReserved_plustok, pop ())); - } - else if (mcLexBuf_currenttoken == mcReserved_minustok) - { - /* avoid dangling else. */ - Expect (mcReserved_minustok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Term (stopset0, stopset1, stopset2); - n = push (decl_makeUnaryTok (mcReserved_minustok, pop ())); - } - else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - /* avoid dangling else. */ - Term (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number { identifier - +", 74); - } -} - - -/* - Term := - % VAR op: toktype ; n: node ; % - Factor { - % op := currenttoken % - MulOperator - % n := pop () % - Factor - % n := push (makeBinaryTok (op, n, pop ())) % - } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok - - cannot reachend -*/ - -static void Term (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - mcReserved_toktype op; - decl_node n; - - Factor (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok)) - { - op = mcLexBuf_currenttoken; - MulOperator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - n = pop (); - Factor (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok)))); - n = push (decl_makeBinaryTok (op, n, pop ())); - } - /* while */ -} - - -/* - PushString := string - % VAR n: node ; % - - % n := push (makeString (curstring)) % - - - first symbols:stringtok - - cannot reachend -*/ - -static void PushString (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - string (stopset0, stopset1, stopset2); - n = push (decl_makeString (curstring)); -} - - -/* - Factor := Number | PushString | SetOrDesignatorOrFunction | - '(' Expression ')' | - 'NOT' ( Factor - % VAR n: node ; % - - % n := push (makeUnaryTok (nottok, pop ())) % - | ConstAttribute - % n := push (makeUnaryTok (nottok, pop ())) % - ) - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok - - cannot reachend -*/ - -static void Factor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0))) - { - Number (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - /* avoid dangling else. */ - PushString (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - /* avoid dangling else. */ - SetOrDesignatorOrFunction (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_nottok) - { - /* avoid dangling else. */ - Expect (mcReserved_nottok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Factor (stopset0, stopset1, stopset2); - n = push (decl_makeUnaryTok (mcReserved_nottok, pop ())); - } - else if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - /* avoid dangling else. */ - ConstAttribute (stopset0, stopset1, stopset2); - n = push (decl_makeUnaryTok (mcReserved_nottok, pop ())); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: NOT ( { identifier string integer number real number", 70); - } -} - - -/* - ComponentElement := Expression - % VAR l, h, n: node ; % - - % l := pop () % - - % h := NIL % - [ '..' Expression - % h := pop () % - - % ErrorArray ('implementation restriction range is not allowed') % - ] - % n := push (includeSetValue (pop (), l, h)) % - - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ComponentElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node l; - decl_node h; - decl_node n; - - Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - l = pop (); - h = static_cast (NULL); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); - h = pop (); - ErrorArray ((const char *) "implementation restriction range is not allowed", 47); - } - n = push (decl_includeSetValue (pop (), l, h)); -} - - -/* - ComponentValue := ComponentElement [ 'BY' - % ErrorArray ('implementation restriction BY not allowed') % - Expression ] - - first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void ComponentValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ComponentElement (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ErrorArray ((const char *) "implementation restriction BY not allowed", 41); - Expression (stopset0, stopset1, stopset2); - } -} - - -/* - ArraySetRecordValue := ComponentValue { ',' ComponentValue } - - first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void ArraySetRecordValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ComponentValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ComponentValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Constructor := '{' - % VAR n: node ; % - - % n := push (makeSetValue ()) % - [ ArraySetRecordValue ] '}' - - first symbols:lcbratok - - cannot reachend -*/ - -static void Constructor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_lcbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - n = push (decl_makeSetValue ()); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ArraySetRecordValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2); -} - - -/* - SetOrDesignatorOrFunction := PushQualident - % VAR q, p, n: node ; % - [ Constructor - % p := pop () % - - % q := pop () % - - % n := push (putSetValue (p, q)) % - | SimpleDes [ - % q := pop () % - ActualParameters - - % p := pop () % - - % p := push (makeFuncCall (q, p)) % - ] ] | - Constructor - - first symbols:identtok, lcbratok - - cannot reachend -*/ - -static void SetOrDesignatorOrFunction (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node q; - decl_node p; - decl_node n; - - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - PushQualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - Constructor (stopset0, stopset1, stopset2); - p = pop (); - q = pop (); - n = push (decl_putSetValue (p, q)); - } - else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - /* avoid dangling else. */ - SimpleDes (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - q = pop (); - ActualParameters (stopset0, stopset1, stopset2); - p = pop (); - p = push (decl_makeFuncCall (q, p)); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ( [ . ^ {", 27); - } - } - /* end of optional [ | ] expression */ - } - else if (mcLexBuf_currenttoken == mcReserved_lcbratok) - { - /* avoid dangling else. */ - Constructor (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: { identifier", 30); - } -} - - -/* - SimpleDes := { SubDesignator } - - first symbols:uparrowtok, periodtok, lsbratok - - reachend -*/ - -static void SimpleDes (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0))) - { - SubDesignator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - ActualParameters := '(' - % VAR n: node ; % - - % n := push (makeExpList ()) % - [ ExpList ] ')' - % assert (isExpList (peep ())) % - - - first symbols:lparatok - - cannot reachend -*/ - -static void ActualParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - n = push (decl_makeExpList ()); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - ExpList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - mcDebug_assert (decl_isExpList (peep ())); -} - - -/* - ExitStatement := - % VAR n: node ; % - 'EXIT' - % IF loopNo = 0 - THEN - ErrorArray ('EXIT can only be used inside a LOOP statement') - ELSE - n := pushStmt (makeExit (peepLoop (), loopNo)) - END % - - - first symbols:exittok - - cannot reachend -*/ - -static void ExitStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - Expect (mcReserved_exittok, stopset0, stopset1, stopset2); - if (loopNo == 0) - { - ErrorArray ((const char *) "EXIT can only be used inside a LOOP statement", 45); - } - else - { - n = pushStmt (decl_makeExit (peepLoop (), loopNo)); - } -} - - -/* - ReturnStatement := - % VAR n: node ; % - - % n := pushStmt (makeReturn ()) % - 'RETURN' [ Expression - % putReturn (n, pop ()) % - ] - % addCommentBody (peepStmt ()) % - - % addCommentAfter (peepStmt ()) % - - % assert (isReturn (peepStmt ())) % - - - first symbols:returntok - - cannot reachend -*/ - -static void ReturnStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node n; - - n = pushStmt (decl_makeReturn ()); - Expect (mcReserved_returntok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - Expression (stopset0, stopset1, stopset2); - decl_putReturn (n, pop ()); - } - decl_addCommentBody (peepStmt ()); - decl_addCommentAfter (peepStmt ()); - mcDebug_assert (decl_isReturn (peepStmt ())); -} - - -/* - Statement := ( AssignmentOrProcedureCall | - IfStatement | CaseStatement | - WhileStatement | - RepeatStatement | - LoopStatement | ForStatement | - WithStatement | AsmStatement | - ExitStatement | ReturnStatement | - RetryStatement | - - % VAR s: node ; % - - % s := pushStmt (NIL) % - ) - - first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok - - reachend -*/ - -static void Statement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node s; - - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - AssignmentOrProcedureCall (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_iftok) - { - /* avoid dangling else. */ - IfStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_casetok) - { - /* avoid dangling else. */ - CaseStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_whiletok) - { - /* avoid dangling else. */ - WhileStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_repeattok) - { - /* avoid dangling else. */ - RepeatStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_looptok) - { - /* avoid dangling else. */ - LoopStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_fortok) - { - /* avoid dangling else. */ - ForStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_withtok) - { - /* avoid dangling else. */ - WithStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_asmtok) - { - /* avoid dangling else. */ - AsmStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_exittok) - { - /* avoid dangling else. */ - ExitStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_returntok) - { - /* avoid dangling else. */ - ReturnStatement (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_retrytok) - { - /* avoid dangling else. */ - RetryStatement (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - s = pushStmt (static_cast (NULL)); - } -} - - -/* - RetryStatement := - % VAR s: node ; % - - % s := pushStmt (makeComment ("retry")) % - 'RETRY' - - first symbols:retrytok - - cannot reachend -*/ - -static void RetryStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node s; - - s = pushStmt (decl_makeComment ((const char *) "retry", 5)); - Expect (mcReserved_retrytok, stopset0, stopset1, stopset2); -} - - -/* - AssignmentOrProcedureCall := - % VAR d, a, p: node ; % - Designator - % d := pop () % - ( ':=' Expression - % a := pushStmt (makeAssignment (d, pop ())) % - | - ActualParameters - - % a := pushStmt (makeFuncCall (d, pop ())) % - | - - % a := pushStmt (makeFuncCall (d, NIL)) % - ) - % addCommentBody (peepStmt ()) % - - % addCommentAfter (peepStmt ()) % - - - first symbols:identtok - - cannot reachend -*/ - -static void AssignmentOrProcedureCall (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node d; - decl_node a; - decl_node p; - - Designator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - d = pop (); - if (mcLexBuf_currenttoken == mcReserved_becomestok) - { - Expect (mcReserved_becomestok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); - a = pushStmt (decl_makeAssignment (d, pop ())); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - ActualParameters (stopset0, stopset1, stopset2); - a = pushStmt (decl_makeFuncCall (d, pop ())); - } - else - { - /* avoid dangling else. */ - a = pushStmt (decl_makeFuncCall (d, static_cast (NULL))); - } - decl_addCommentBody (peepStmt ()); - decl_addCommentAfter (peepStmt ()); -} - - -/* - StatementSequence := - % VAR s, t: node ; % - - % s := pushStmt (makeStatementSequence ()) % - - % assert (isStatementSequence (peepStmt ())) % - Statement - % addStatement (s, popStmt ()) % - - % assert (isStatementSequence (peepStmt ())) % - { ';' Statement - % addStatement (s, popStmt ()) % - - % assert (isStatementSequence (peepStmt ())) % - } - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok - - reachend -*/ - -static void StatementSequence (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node s; - decl_node t; - - s = pushStmt (decl_makeStatementSequence ()); - mcDebug_assert (decl_isStatementSequence (peepStmt ())); - Statement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - decl_addStatement (s, popStmt ()); - mcDebug_assert (decl_isStatementSequence (peepStmt ())); - while (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Statement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - decl_addStatement (s, popStmt ()); - mcDebug_assert (decl_isStatementSequence (peepStmt ())); - } - /* while */ -} - - -/* - IfStatement := - % VAR i, a, b: node ; % - 'IF' - % b := makeCommentS (getBodyComment ()) % - Expression - % a := makeCommentS (getAfterComment ()) % - 'THEN' StatementSequence - % i := pushStmt (makeIf (pop (), popStmt ())) % - - % addIfComments (i, b, a) % - { 'ELSIF' - % b := makeCommentS (getBodyComment ()) % - Expression - % a := makeCommentS (getAfterComment ()) % - 'THEN' - % addElseComments (peepStmt (), b, a) % - StatementSequence - % i := makeElsif (i, pop (), popStmt ()) % - } [ 'ELSE' StatementSequence - % putElse (i, popStmt ()) % - ] 'END' - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % assert (isIf (peepStmt ())) % - - % addIfEndComments (peepStmt (), b, a) % - - - first symbols:iftok - - cannot reachend -*/ - -static void IfStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node i; - decl_node a; - decl_node b; - - Expect (mcReserved_iftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - b = decl_makeCommentS (mcLexBuf_getBodyComment ()); - Expression (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - a = decl_makeCommentS (mcLexBuf_getAfterComment ()); - Expect (mcReserved_thentok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - i = pushStmt (decl_makeIf (pop (), popStmt ())); - decl_addIfComments (i, b, a); - while (mcLexBuf_currenttoken == mcReserved_elsiftok) - { - Expect (mcReserved_elsiftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - b = decl_makeCommentS (mcLexBuf_getBodyComment ()); - Expression (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok)))); - a = decl_makeCommentS (mcLexBuf_getAfterComment ()); - Expect (mcReserved_thentok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - decl_addElseComments (peepStmt (), b, a); - StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2); - i = decl_makeElsif (i, pop (), popStmt ()); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - Expect (mcReserved_elsetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - decl_putElse (i, popStmt ()); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - b = decl_makeCommentS (mcLexBuf_getBodyComment ()); - a = decl_makeCommentS (mcLexBuf_getAfterComment ()); - mcDebug_assert (decl_isIf (peepStmt ())); - decl_addIfEndComments (peepStmt (), b, a); -} - - -/* - CaseStatement := - % VAR s, e: node ; % - - % s := pushStmt (makeCase ()) % - 'CASE' Expression - % s := putCaseExpression (s, pop ()) % - 'OF' Case { '|' Case } CaseEndStatement - - first symbols:casetok - - cannot reachend -*/ - -static void CaseStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node s; - decl_node e; - - s = pushStmt (decl_makeCase ()); - Expect (mcReserved_casetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - s = decl_putCaseExpression (s, pop ()); - Expect (mcReserved_oftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Case (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - while (mcLexBuf_currenttoken == mcReserved_bartok) - { - Expect (mcReserved_bartok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - Case (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2); - } - /* while */ - CaseEndStatement (stopset0, stopset1, stopset2); -} - - -/* - CaseEndStatement := - % VAR c: node ; % - 'END' | 'ELSE' - % c := peepStmt () % - StatementSequence - % c := putCaseElse (c, popStmt ()) % - 'END' - - first symbols:elsetok, endtok - - cannot reachend -*/ - -static void CaseEndStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node c; - - if (mcLexBuf_currenttoken == mcReserved_endtok) - { - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_elsetok) - { - /* avoid dangling else. */ - Expect (mcReserved_elsetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - c = peepStmt (); - StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - c = decl_putCaseElse (c, popStmt ()); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ELSE END", 26); - } -} - - -/* - Case := [ CaseLabelList ':' - % VAR l, c: node ; % - - % l := pop () % - - % c := peepStmt () % - StatementSequence - % c := putCaseStatement (c, l, popStmt ()) % - ] - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - reachend -*/ - -static void Case (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node l; - decl_node c; - - if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))) - { - CaseLabelList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - l = pop (); - c = peepStmt (); - StatementSequence (stopset0, stopset1, stopset2); - c = decl_putCaseStatement (c, l, popStmt ()); - } -} - - -/* - CaseLabelList := - % VAR l: node ; % - - % l := push (makeCaseList ()) % - CaseLabels { ',' CaseLabels } - - first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok - - cannot reachend -*/ - -static void CaseLabelList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node l; - - l = push (decl_makeCaseList ()); - CaseLabels (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)))); - CaseLabels (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CaseLabels := - % VAR lo, hi, l: node ; % - - % lo := NIL ; hi := NIL % - - % l := peep () % - ConstExpression - % lo := pop () % - [ '..' ConstExpression - % hi := pop () % - ] - % l := putCaseRange (l, lo, hi) % - - - first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok - - cannot reachend -*/ - -static void CaseLabels (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node lo; - decl_node hi; - decl_node l; - - lo = static_cast (NULL); - hi = static_cast (NULL); - l = peep (); - ConstExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2); - lo = pop (); - if (mcLexBuf_currenttoken == mcReserved_periodperiodtok) - { - Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1, stopset2); - hi = pop (); - } - l = decl_putCaseRange (l, lo, hi); -} - - -/* - WhileStatement := - % VAR s, w, e, a, b: node ; % - - % w := pushStmt (makeWhile ()) % - 'WHILE' Expression 'DO' - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % addWhileDoComment (w, b, a) % - - % e := pop () % - StatementSequence - % s := popStmt () % - 'END' - % assert (isStatementSequence (peepStmt ())) % - - % putWhile (w, e, s) % - - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % addWhileEndComment (w, b, a) % - - - first symbols:whiletok - - cannot reachend -*/ - -static void WhileStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node s; - decl_node w; - decl_node e; - decl_node a; - decl_node b; - - w = pushStmt (decl_makeWhile ()); - Expect (mcReserved_whiletok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - b = decl_makeCommentS (mcLexBuf_getBodyComment ()); - a = decl_makeCommentS (mcLexBuf_getAfterComment ()); - decl_addWhileDoComment (w, b, a); - e = pop (); - StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - s = popStmt (); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - /* assert (isStatementSequence (peepStmt ())) */ - decl_putWhile (w, e, s); - b = decl_makeCommentS (mcLexBuf_getBodyComment ()); - a = decl_makeCommentS (mcLexBuf_getAfterComment ()); - decl_addWhileEndComment (w, b, a); -} - - -/* - RepeatStatement := - % VAR r, s, a, b: node ; % - - % r := pushStmt (makeRepeat ()) % - 'REPEAT' - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % addRepeatComment (r, b, a) % - StatementSequence - % s := popStmt () % - 'UNTIL' Expression - % putRepeat (r, s, pop ()) % - - % b := makeCommentS (getBodyComment ()) % - - % a := makeCommentS (getAfterComment ()) % - - % addUntilComment (r, b, a) % - - - first symbols:repeattok - - cannot reachend -*/ - -static void RepeatStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node r; - decl_node s; - decl_node a; - decl_node b; - - r = pushStmt (decl_makeRepeat ()); - Expect (mcReserved_repeattok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - b = decl_makeCommentS (mcLexBuf_getBodyComment ()); - a = decl_makeCommentS (mcLexBuf_getAfterComment ()); - decl_addRepeatComment (r, b, a); - StatementSequence (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok)))); - s = popStmt (); - Expect (mcReserved_untiltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2); - decl_putRepeat (r, s, pop ()); - b = decl_makeCommentS (mcLexBuf_getBodyComment ()); - a = decl_makeCommentS (mcLexBuf_getAfterComment ()); - decl_addUntilComment (r, b, a); -} - - -/* - ForStatement := - % VAR f, i, s, e, b: node ; % - - % b := NIL % - - % f := pushStmt (makeFor ()) % - 'FOR' Ident - % i := lookupWithSym (curident) % - ':=' Expression - % s := pop () % - 'TO' Expression - % e := pop () % - [ 'BY' ConstExpression - % b := pop () % - ] 'DO' StatementSequence - % putFor (f, i, s, e, b, popStmt ()) % - 'END' - - first symbols:fortok - - cannot reachend -*/ - -static void ForStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node f; - decl_node i; - decl_node s; - decl_node e; - decl_node b; - - b = static_cast (NULL); - f = pushStmt (decl_makeFor ()); - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2); - i = lookupWithSym (curident); - Expect (mcReserved_becomestok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok)))); - s = pop (); - Expect (mcReserved_totok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - e = pop (); - if (mcLexBuf_currenttoken == mcReserved_bytok) - { - Expect (mcReserved_bytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpression (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - b = pop (); - } - Expect (mcReserved_dotok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - decl_putFor (f, i, s, e, b, popStmt ()); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - LoopStatement := - % VAR l, s: node ; % - 'LOOP' - % l := pushStmt (pushLoop (makeLoop ())) % - - % INC (loopNo) % - StatementSequence - % s := popStmt () % - - % putLoop (l, s) % - - % DEC (loopNo) % - 'END' - % l := popLoop () % - - % assert (isLoop (peepStmt ())) % - - - first symbols:looptok - - cannot reachend -*/ - -static void LoopStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node l; - decl_node s; - - Expect (mcReserved_looptok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - l = pushStmt (pushLoop (decl_makeLoop ())); - loopNo += 1; - StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - s = popStmt (); - decl_putLoop (l, s); - loopNo -= 1; - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - l = popLoop (); - mcDebug_assert (decl_isLoop (peepStmt ())); -} - - -/* - WithStatement := 'WITH' Designator 'DO' - % startWith (pop ()) % - StatementSequence 'END' - % endWith % - - - first symbols:withtok - - cannot reachend -*/ - -static void WithStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Designator (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_dotok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - startWith (pop ()); - StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); - endWith (); -} - - -/* - ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock - Ident - % leaveScope % - - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ProcedureHeading (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - ProcedureBlock (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); - decl_leaveScope (); -} - - -/* - ProcedureIdent := Ident - % curproc := lookupSym (curident) % - - % enterScope (curproc) % - - % setProcedureComment (lastcomment, curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void ProcedureIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_lookupSym (curident); - decl_enterScope (curproc); - mcComment_setProcedureComment (mcLexBuf_lastcomment, curident); -} - - -/* - DefProcedureIdent := Ident - % curproc := lookupSym (curident) % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefProcedureIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0, stopset1, stopset2); - curproc = decl_lookupSym (curident); -} - - -/* - DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__' - '(' '(' Ident ')' ')' | - '__INLINE__' ] - - first symbols:inlinetok, attributetok - - reachend -*/ - -static void DefineBuiltinProcedure (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_attributetok) - { - Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok)))); - Expect (mcReserved_builtintok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42); - } - } - /* end of optional [ | ] expression */ -} - - -/* - ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure - ( ProcedureIdent [ FormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void ProcedureHeading (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - FormalParameters (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - Builtin := [ '__BUILTIN__' | '__INLINE__' ] - - first symbols:inlinetok, builtintok - - reachend -*/ - -static void Builtin (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - /* seen optional [ | ] expression */ - if (mcLexBuf_currenttoken == mcReserved_builtintok) - { - Expect (mcReserved_builtintok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_inlinetok) - { - /* avoid dangling else. */ - Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40); - } - } - /* end of optional [ | ] expression */ -} - - -/* - DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent - [ DefFormalParameters ] - AttributeNoReturn ) - - first symbols:proceduretok - - cannot reachend -*/ - -static void DefProcedureHeading (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Builtin (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - DefProcedureIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - DefFormalParameters (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - } - AttributeNoReturn (stopset0, stopset1, stopset2); -} - - -/* - ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ] - 'END' - - first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok - - cannot reachend -*/ - -static void ProcedureBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ProcedureBlockBody (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - } - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - Block := { Declaration } InitialBlock FinalBlock - 'END' - - first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok - - cannot reachend -*/ - -static void Block (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Declaration (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - InitialBlock (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2); - FinalBlock (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_endtok, stopset0, stopset1, stopset2); -} - - -/* - InitialBlock := [ 'BEGIN' InitialBlockBody ] - - first symbols:begintok - - reachend -*/ - -static void InitialBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_begintok) - { - Expect (mcReserved_begintok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - InitialBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlock := [ 'FINALLY' FinalBlockBody ] - - first symbols:finallytok - - reachend -*/ - -static void FinalBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_finallytok) - { - Expect (mcReserved_finallytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - FinalBlockBody (stopset0, stopset1, stopset2); - } -} - - -/* - InitialBlockBody := NormalPart - % putBegin (curmodule, popStmt ()) % - [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void InitialBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - decl_putBegin (curmodule, popStmt ()); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - FinalBlockBody := NormalPart - % putFinally (curmodule, popStmt ()) % - [ 'EXCEPT' ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void FinalBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - NormalPart (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - decl_putFinally (curmodule, popStmt ()); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - ProcedureBlockBody := ProcedureNormalPart [ 'EXCEPT' - ExceptionalPart ] - - first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok - - reachend -*/ - -static void ProcedureBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - ProcedureNormalPart (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2); - if (mcLexBuf_currenttoken == mcReserved_excepttok) - { - Expect (mcReserved_excepttok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - ExceptionalPart (stopset0, stopset1, stopset2); - } -} - - -/* - ProcedureNormalPart := StatementSequence - % putBegin (curproc, popStmt ()) % - - - first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok - - reachend -*/ - -static void ProcedureNormalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); - decl_putBegin (curproc, popStmt ()); -} - - -/* - NormalPart := StatementSequence - - first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok - - reachend -*/ - -static void NormalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - ExceptionalPart := StatementSequence - - first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok - - reachend -*/ - -static void ExceptionalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - StatementSequence (stopset0, stopset1, stopset2); -} - - -/* - Declaration := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - ProcedureDeclaration ';' | - ModuleDeclaration ';' - - first symbols:moduletok, proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Declaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - ConstantDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeDeclaration (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_moduletok) - { - /* avoid dangling else. */ - ModuleDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49); - } -} - - -/* - DefFormalParameters := '(' - % paramEnter (curproc) % - [ DefMultiFPSection ] ')' - - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void DefFormalParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - decl_paramEnter (curproc); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - DefMultiFPSection (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - decl_paramLeave (curproc); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - AttributeNoReturn := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeNoReturn (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - AttributeUnused := [ '' ] - - first symbols:ldirectivetok - - reachend -*/ - -static void AttributeUnused (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2); - } -} - - -/* - DefMultiFPSection := DefExtendedFP | - FPSection [ ';' DefMultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefMultiFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - DefExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - DefMultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FormalParameters := '(' - % paramEnter (curproc) % - [ MultiFPSection ] ')' - % paramLeave (curproc) % - FormalReturn - - first symbols:lparatok - - cannot reachend -*/ - -static void FormalParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - decl_paramEnter (curproc); - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0)))) - { - MultiFPSection (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - decl_paramLeave (curproc); - FormalReturn (stopset0, stopset1, stopset2); -} - - -/* - MultiFPSection := ExtendedFP | FPSection [ ';' - MultiFPSection ] - - first symbols:identtok, vartok, lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void MultiFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)) - { - ExtendedFP (stopset0, stopset1, stopset2); - } - else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))) - { - /* avoid dangling else. */ - FPSection (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - MultiFPSection (stopset0, stopset1, stopset2); - } - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38); - } -} - - -/* - FPSection := NonVarFPSection | - VarFPSection - - first symbols:vartok, identtok - - cannot reachend -*/ - -static void FPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - NonVarFPSection (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - VarFPSection (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: VAR identifier", 32); - } -} - - -/* - DefExtendedFP := DefOptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void DefExtendedFP (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - DefOptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - ExtendedFP := OptArg | '...' - - first symbols:lsbratok, periodperiodperiodtok - - cannot reachend -*/ - -static void ExtendedFP (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - OptArg (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok) - { - /* avoid dangling else. */ - Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: ... [", 23); - } -} - - -/* - VarFPSection := 'VAR' IdentList ':' FormalType [ - AttributeUnused ] - - first symbols:vartok - - cannot reachend -*/ - -static void VarFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } -} - - -/* - NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ] - - first symbols:identtok - - cannot reachend -*/ - -static void NonVarFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_ldirectivetok) - { - AttributeUnused (stopset0, stopset1, stopset2); - } -} - - -/* - OptArg := '[' Ident ':' FormalType [ '=' ConstExpressionNop ] - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void OptArg (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - Expect (mcReserved_equaltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - DefOptArg := '[' Ident ':' FormalType '=' ConstExpressionNop - ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void DefOptArg (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_colontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FormalType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_equaltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - FormalType := { 'ARRAY' 'OF' } Qualident - - first symbols:identtok, arraytok - - cannot reachend -*/ - -static void FormalType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_arraytok) - { - Expect (mcReserved_arraytok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_oftok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - Qualident (stopset0, stopset1, stopset2); -} - - -/* - ModuleDeclaration := 'MODULE' Ident [ Priority ] - ';' { Import } [ Export ] - Block Ident - - first symbols:moduletok - - cannot reachend -*/ - -static void ModuleDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - Priority (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - } - Block (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1, stopset2); -} - - -/* - Priority := '[' ConstExpressionNop ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void Priority (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)))); - ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - Export := 'EXPORT' ( 'QUALIFIED' IdentList | - 'UNQUALIFIED' IdentList | - IdentList ) ';' - - first symbols:exporttok - - cannot reachend -*/ - -static void Export (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_exporttok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_qualifiedtok) - { - Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok) - { - /* avoid dangling else. */ - Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_identtok) - { - /* avoid dangling else. */ - IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50); - } - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - FromIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void FromIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - FromImport := 'FROM' Ident 'IMPORT' FromIdentList - ';' - - first symbols:fromtok - - cannot reachend -*/ - -static void FromImport (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - FromIdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - ImportModuleList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void ImportModuleList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - WithoutFromImport := 'IMPORT' ImportModuleList ';' - - first symbols:importtok - - cannot reachend -*/ - -static void WithoutFromImport (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - ImportModuleList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); -} - - -/* - Import := FromImport | WithoutFromImport - - first symbols:importtok, fromtok - - cannot reachend -*/ - -static void Import (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_fromtok) - { - FromImport (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_importtok) - { - /* avoid dangling else. */ - WithoutFromImport (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29); - } -} - - -/* - DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR' - string ] - Ident ';' - % curmodule := lookupDef (curident) % - - % enterScope (curmodule) % - { Import } [ Export ] { Definition } - 'END' Ident '.' - % checkEndName (curmodule, curident, 'definition module') % - - % leaveScope % - - - first symbols:definitiontok - - cannot reachend -*/ - -static void DefinitionModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2); - Expect (mcReserved_moduletok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_fortok) - { - Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok)))); - curmodule = decl_lookupDef (curident); - decl_enterScope (curmodule); - while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0))) - { - Import (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - if (mcLexBuf_currenttoken == mcReserved_exporttok) - { - Export (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))) - { - Definition (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)))); - } - /* while */ - Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2); - checkEndName (curmodule, curident, (const char *) "definition module", 17); - decl_leaveScope (); -} - - -/* - PushQualident := - % VAR type, field: node ; % - Ident - % qualid := push (lookupWithSym (curident)) % - - % IF qualid = NIL - THEN - metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident) - END % - [ '.' - % IF NOT isQualident (qualid) - THEN - ErrorArray ('the first component of this qualident must be a definition module or a parameter/variable/constant which has record type') - END % - Ident - % IF isDef (qualid) - THEN - qualid := replace (lookupInScope (qualid, curident)) - ELSE - type := skipType (getType (qualid)) ; - field := lookupInScope (type, curident) ; - IF field = NIL - THEN - metaError2 ('field {%1k} cannot be found in {%2ad}', curident, qualid) - ELSE - qualid := replace (makeComponentRef (qualid, field)) - END - END ; - IF qualid = NIL - THEN - metaError1 ('qualified component of the identifier {%1k} cannot be found', curident) - END % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void PushQualident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node type; - decl_node field; - - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2); - qualid = push (lookupWithSym (curident)); - if (qualid == NULL) - { - mcMetaError_metaError1 ((const char *) "the symbol {%1k} is not visible in this scope (or any other nested scope)", 73, (const unsigned char *) &curident, (sizeof (curident)-1)); - } - if (mcLexBuf_currenttoken == mcReserved_periodtok) - { - Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - if (! (isQualident (qualid))) - { - ErrorArray ((const char *) "the first component of this qualident must be a definition module or a parameter/variable/constant which has record type", 120); - } - Ident (stopset0, stopset1, stopset2); - if (decl_isDef (qualid)) - { - qualid = replace (decl_lookupInScope (qualid, curident)); - } - else - { - type = decl_skipType (decl_getType (qualid)); - field = decl_lookupInScope (type, curident); - if (field == NULL) - { - mcMetaError_metaError2 ((const char *) "field {%1k} cannot be found in {%2ad}", 37, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &qualid, (sizeof (qualid)-1)); - } - else - { - qualid = replace (decl_makeComponentRef (qualid, field)); - } - } - if (qualid == NULL) - { - mcMetaError_metaError1 ((const char *) "qualified component of the identifier {%1k} cannot be found", 59, (const unsigned char *) &curident, (sizeof (curident)-1)); - } - } -} - - -/* - OptSubrange := [ SubrangeType ] - - first symbols:lsbratok - - reachend -*/ - -static void OptSubrange (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - SubrangeType (stopset0, stopset1, stopset2); - } -} - - -/* - TypeEquiv := Qualident OptSubrange - - first symbols:identtok - - cannot reachend -*/ - -static void TypeEquiv (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Qualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2); - OptSubrange (stopset0, stopset1, stopset2); -} - - -/* - EnumIdentList := Ident { ',' Ident } - - first symbols:identtok - - cannot reachend -*/ - -static void EnumIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - Enumeration := '(' EnumIdentList ')' - - first symbols:lparatok - - cannot reachend -*/ - -static void Enumeration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - EnumIdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - SimpleType := TypeEquiv | Enumeration | - SubrangeType - - first symbols:lsbratok, lparatok, identtok - - cannot reachend -*/ - -static void SimpleType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeEquiv (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lparatok) - { - /* avoid dangling else. */ - Enumeration (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - /* avoid dangling else. */ - SubrangeType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: [ ( identifier", 32); - } -} - - -/* - Type := SimpleType | ArrayType | RecordType | - SetType | PointerType | ProcedureType - - first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok - - cannot reachend -*/ - -static void Type (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok)) - { - SimpleType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_arraytok) - { - /* avoid dangling else. */ - ArrayType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_recordtok) - { - /* avoid dangling else. */ - RecordType (stopset0, stopset1, stopset2); - } - else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok)) - { - /* avoid dangling else. */ - SetType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_pointertok) - { - /* avoid dangling else. */ - PointerType (stopset0, stopset1, stopset2); - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - ProcedureType (stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80); - } -} - - -/* - TypeDeclaration := { Ident ( ';' | '=' Type Alignment - ';' ) } - - first symbols:identtok - - reachend -*/ - -static void TypeDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_semicolontok) - { - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else if (mcLexBuf_currenttoken == mcReserved_equaltok) - { - /* avoid dangling else. */ - Expect (mcReserved_equaltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Type (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Alignment (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: = ;", 21); - } - } - /* while */ -} - - -/* - Definition := 'CONST' { ConstantDeclaration ';' } | - 'TYPE' { TypeDeclaration } | - 'VAR' { VariableDeclaration ';' } | - DefProcedureHeading ';' - - first symbols:proceduretok, vartok, typetok, consttok - - cannot reachend -*/ - -static void Definition (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_consttok) - { - Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - ConstantDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_typetok) - { - /* avoid dangling else. */ - Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - TypeDeclaration (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_vartok) - { - /* avoid dangling else. */ - Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - while (mcLexBuf_currenttoken == mcReserved_identtok) - { - VariableDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - } - /* while */ - } - else if (mcLexBuf_currenttoken == mcReserved_proceduretok) - { - /* avoid dangling else. */ - DefProcedureHeading (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2); - } - else - { - /* avoid dangling else. */ - ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42); - } -} - - -/* - AsmStatement := - % VAR s: node ; % - - % s := pushStmt (makeComment ("asm")) % - 'ASM' [ 'VOLATILE' ] '(' AsmOperands - ')' - - first symbols:asmtok - - cannot reachend -*/ - -static void AsmStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - decl_node s; - - s = pushStmt (decl_makeComment ((const char *) "asm", 3)); - Expect (mcReserved_asmtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok)))); - if (mcLexBuf_currenttoken == mcReserved_volatiletok) - { - Expect (mcReserved_volatiletok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - } - Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmOperands (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperands := string [ AsmOperandSpec ] - - first symbols:stringtok - - cannot reachend -*/ - -static void AsmOperands (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - string (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - AsmOperandSpec (stopset0, stopset1, stopset2); - } -} - - -/* - AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ - ':' TrashList ] ] ] - - first symbols:colontok - - reachend -*/ - -static void AsmOperandSpec (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2); - if (mcLexBuf_currenttoken == mcReserved_colontok) - { - Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - TrashList (stopset0, stopset1, stopset2); - } - } - } -} - - -/* - AsmList := [ AsmElement ] { ',' AsmElement } - - first symbols:lsbratok, stringtok, commatok - - reachend -*/ - -static void AsmList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok)) - { - AsmElement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - AsmElement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - NamedOperand := '[' Ident ']' - - first symbols:lsbratok - - cannot reachend -*/ - -static void NamedOperand (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)))); - Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2); -} - - -/* - AsmOperandName := [ NamedOperand ] - - first symbols:lsbratok - - reachend -*/ - -static void AsmOperandName (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_lsbratok) - { - NamedOperand (stopset0, stopset1, stopset2); - } -} - - -/* - AsmElement := AsmOperandName string '(' Expression - ')' - - first symbols:stringtok, lsbratok - - cannot reachend -*/ - -static void AsmElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - AsmOperandName (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)))); - Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2); - Expect (mcReserved_rparatok, stopset0, stopset1, stopset2); -} - - -/* - TrashList := [ string ] { ',' string } - - first symbols:commatok, stringtok - - reachend -*/ - -static void TrashList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2) -{ - if (mcLexBuf_currenttoken == mcReserved_stringtok) - { - string (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - while (mcLexBuf_currenttoken == mcReserved_commatok) - { - Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)))); - string (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2); - } - /* while */ -} - - -/* - CompilationUnit - returns TRUE if the input was correct enough to parse - in future passes. -*/ - -extern "C" unsigned int mcp5_CompilationUnit (void) -{ - stk = mcStack_init (); - withStk = mcStack_init (); - stmtStk = mcStack_init (); - loopStk = mcStack_init (); - loopNo = 0; - WasNoError = TRUE; - FileUnit ((mcp5_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp5_SetOfStop1) 0, (mcp5_SetOfStop2) 0); - mcStack_kill (&stk); - mcStack_kill (&withStk); - mcStack_kill (&stmtStk); - mcStack_kill (&loopStk); - return WasNoError; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_mcp5_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_mcp5_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GnameKey.c b/gcc/m2/mc-boot/GnameKey.c deleted file mode 100644 index b00a59868e4c..000000000000 --- a/gcc/m2/mc-boot/GnameKey.c +++ /dev/null @@ -1,584 +0,0 @@ -/* do not edit automatically generated by mc from nameKey. */ -/* nameKey.mod provides a dynamic binary tree name to key. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _nameKey_H -#define _nameKey_C - -# include "GSYSTEM.h" -# include "GStorage.h" -# include "GIndexing.h" -# include "GStrIO.h" -# include "GStdIO.h" -# include "GNumberIO.h" -# include "GStrLib.h" -# include "Glibc.h" -# include "GASCII.h" -# include "GM2RTS.h" - -# define nameKey_NulName 0 -typedef unsigned int nameKey_Name; - -typedef struct nameKey__T1_r nameKey__T1; - -typedef char *nameKey_ptrToChar; - -typedef nameKey__T1 *nameKey_nameNode; - -typedef enum {nameKey_less, nameKey_equal, nameKey_greater} nameKey_comparison; - -struct nameKey__T1_r { - nameKey_ptrToChar data; - nameKey_Name key; - nameKey_nameNode left; - nameKey_nameNode right; - }; - -static nameKey_nameNode binaryTree; -static Indexing_Index keyIndex; -static unsigned int lastIndice; - -/* - makeKey - returns the Key of the symbol, a. If a is not in the - name table then it is added, otherwise the Key of a is returned - directly. Note that the name table has no scope - it merely - presents a more convienient way of expressing strings. By a Key. -*/ - -extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high); - -/* - makekey - returns the Key of the symbol, a. If a is not in the - name table then it is added, otherwise the Key of a is returned - directly. Note that the name table has no scope - it merely - presents a more convienient way of expressing strings. By a Key. - These keys last for the duration of compilation. -*/ - -extern "C" nameKey_Name nameKey_makekey (void * a); - -/* - getKey - returns the name, a, of the key, Key. -*/ - -extern "C" void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high); - -/* - lengthKey - returns the StrLen of Key. -*/ - -extern "C" unsigned int nameKey_lengthKey (nameKey_Name key); - -/* - isKey - returns TRUE if string, a, is currently a key. - We dont use the Compare function, we inline it and avoid - converting, a, into a String, for speed. -*/ - -extern "C" unsigned int nameKey_isKey (const char *a_, unsigned int _a_high); - -/* - keyToCharStar - returns the C char * string equivalent for, key. -*/ - -extern "C" void nameKey_writeKey (nameKey_Name key); - -/* - isSameExcludingCase - returns TRUE if key1 and key2 are - the same. It is case insensitive. - This function deliberately inlines CAP for speed. -*/ - -extern "C" unsigned int nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2); - -/* - keyToCharStar - returns the C char * string equivalent for, key. -*/ - -extern "C" void * nameKey_keyToCharStar (nameKey_Name key); - -/* - doMakeKey - finds the name, n, in the tree or else create a name. - If a name is found then the string, n, is deallocated. -*/ - -static nameKey_Name doMakeKey (nameKey_ptrToChar n, unsigned int higha); - -/* - compare - return the result of Names[i] with Names[j] -*/ - -static nameKey_comparison compare (nameKey_ptrToChar pi, nameKey_Name j); - -/* - findNodeAndParentInTree - search BinaryTree for a name. - If this name is found in the BinaryTree then - child is set to this name and father is set to the node above. - A comparison is returned to assist adding entries into this tree. -*/ - -static nameKey_comparison findNodeAndParentInTree (nameKey_ptrToChar n, nameKey_nameNode *child, nameKey_nameNode *father); - - -/* - doMakeKey - finds the name, n, in the tree or else create a name. - If a name is found then the string, n, is deallocated. -*/ - -static nameKey_Name doMakeKey (nameKey_ptrToChar n, unsigned int higha) -{ - nameKey_comparison result; - nameKey_nameNode father; - nameKey_nameNode child; - nameKey_Name k; - - result = findNodeAndParentInTree (n, &child, &father); - if (child == NULL) - { - if (result == nameKey_less) - { - Storage_ALLOCATE ((void **) &child, sizeof (nameKey__T1)); - father->left = child; - } - else if (result == nameKey_greater) - { - /* avoid dangling else. */ - Storage_ALLOCATE ((void **) &child, sizeof (nameKey__T1)); - father->right = child; - } - child->right = NULL; - child->left = NULL; - lastIndice += 1; - child->key = lastIndice; - child->data = n; - Indexing_PutIndice (keyIndex, child->key, reinterpret_cast (n)); - k = lastIndice; - } - else - { - Storage_DEALLOCATE (reinterpret_cast (&n), higha+1); - k = child->key; - } - return k; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - compare - return the result of Names[i] with Names[j] -*/ - -static nameKey_comparison compare (nameKey_ptrToChar pi, nameKey_Name j) -{ - nameKey_ptrToChar pj; - char c1; - char c2; - - pj = static_cast (nameKey_keyToCharStar (j)); - c1 = (*pi); - c2 = (*pj); - while ((c1 != ASCII_nul) || (c2 != ASCII_nul)) - { - if (c1 < c2) - { - return nameKey_less; - } - else if (c1 > c2) - { - /* avoid dangling else. */ - return nameKey_greater; - } - else - { - /* avoid dangling else. */ - pi += 1; - pj += 1; - c1 = (*pi); - c2 = (*pj); - } - } - return nameKey_equal; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - findNodeAndParentInTree - search BinaryTree for a name. - If this name is found in the BinaryTree then - child is set to this name and father is set to the node above. - A comparison is returned to assist adding entries into this tree. -*/ - -static nameKey_comparison findNodeAndParentInTree (nameKey_ptrToChar n, nameKey_nameNode *child, nameKey_nameNode *father) -{ - nameKey_comparison result; - - /* firstly set up the initial values of child and father, using sentinal node */ - (*father) = binaryTree; - (*child) = binaryTree->left; - if ((*child) == NULL) - { - return nameKey_less; - } - else - { - do { - result = compare (n, (*child)->key); - if (result == nameKey_less) - { - (*father) = (*child); - (*child) = (*child)->left; - } - else if (result == nameKey_greater) - { - /* avoid dangling else. */ - (*father) = (*child); - (*child) = (*child)->right; - } - } while (! (((*child) == NULL) || (result == nameKey_equal))); - return result; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - makeKey - returns the Key of the symbol, a. If a is not in the - name table then it is added, otherwise the Key of a is returned - directly. Note that the name table has no scope - it merely - presents a more convienient way of expressing strings. By a Key. -*/ - -extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high) -{ - nameKey_ptrToChar n; - nameKey_ptrToChar p; - unsigned int i; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - higha = StrLib_StrLen ((const char *) a, _a_high); - Storage_ALLOCATE (reinterpret_cast (&p), higha+1); - if (p == NULL) - { - M2RTS_HALT (-1); /* out of memory error */ - __builtin_unreachable (); - } - else - { - n = p; - i = 0; - while (i < higha) - { - (*p) = a[i]; - i += 1; - p += 1; - } - (*p) = ASCII_nul; - return doMakeKey (n, higha); - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/nameKey.def", 20, 1); - __builtin_unreachable (); -} - - -/* - makekey - returns the Key of the symbol, a. If a is not in the - name table then it is added, otherwise the Key of a is returned - directly. Note that the name table has no scope - it merely - presents a more convienient way of expressing strings. By a Key. - These keys last for the duration of compilation. -*/ - -extern "C" nameKey_Name nameKey_makekey (void * a) -{ - nameKey_ptrToChar n; - nameKey_ptrToChar p; - nameKey_ptrToChar pa; - unsigned int i; - unsigned int higha; - - if (a == NULL) - { - return nameKey_NulName; - } - else - { - higha = static_cast (libc_strlen (a)); - Storage_ALLOCATE (reinterpret_cast (&p), higha+1); - if (p == NULL) - { - M2RTS_HALT (-1); /* out of memory error */ - __builtin_unreachable (); - } - else - { - n = p; - pa = static_cast (a); - i = 0; - while (i < higha) - { - (*p) = (*pa); - i += 1; - p += 1; - pa += 1; - } - (*p) = ASCII_nul; - return doMakeKey (n, higha); - } - } - ReturnException ("../../gcc-read-write/gcc/m2/mc/nameKey.def", 20, 1); - __builtin_unreachable (); -} - - -/* - getKey - returns the name, a, of the key, Key. -*/ - -extern "C" void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high) -{ - nameKey_ptrToChar p; - unsigned int i; - unsigned int higha; - - p = static_cast (nameKey_keyToCharStar (key)); - i = 0; - higha = _a_high; - while (((p != NULL) && (i <= higha)) && ((*p) != ASCII_nul)) - { - a[i] = (*p); - p += 1; - i += 1; - } - if (i <= higha) - { - a[i] = ASCII_nul; - } -} - - -/* - lengthKey - returns the StrLen of Key. -*/ - -extern "C" unsigned int nameKey_lengthKey (nameKey_Name key) -{ - unsigned int i; - nameKey_ptrToChar p; - - p = static_cast (nameKey_keyToCharStar (key)); - i = 0; - while ((*p) != ASCII_nul) - { - i += 1; - p += 1; - } - return i; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - isKey - returns TRUE if string, a, is currently a key. - We dont use the Compare function, we inline it and avoid - converting, a, into a String, for speed. -*/ - -extern "C" unsigned int nameKey_isKey (const char *a_, unsigned int _a_high) -{ - nameKey_nameNode child; - nameKey_ptrToChar p; - unsigned int i; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - /* firstly set up the initial values of child, using sentinal node */ - child = binaryTree->left; - if (child != NULL) - { - do { - i = 0; - higha = _a_high; - p = static_cast (nameKey_keyToCharStar (child->key)); - while ((i <= higha) && (a[i] != ASCII_nul)) - { - if (a[i] < (*p)) - { - child = child->left; - i = higha; - } - else if (a[i] > (*p)) - { - /* avoid dangling else. */ - child = child->right; - i = higha; - } - else - { - /* avoid dangling else. */ - if ((a[i] == ASCII_nul) || (i == higha)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((*p) == ASCII_nul) - { - return TRUE; - } - else - { - child = child->left; - } - } - p += 1; - } - i += 1; - } - } while (! (child == NULL)); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - keyToCharStar - returns the C char * string equivalent for, key. -*/ - -extern "C" void nameKey_writeKey (nameKey_Name key) -{ - nameKey_ptrToChar s; - - s = static_cast (nameKey_keyToCharStar (key)); - while ((s != NULL) && ((*s) != ASCII_nul)) - { - StdIO_Write ((*s)); - s += 1; - } -} - - -/* - isSameExcludingCase - returns TRUE if key1 and key2 are - the same. It is case insensitive. - This function deliberately inlines CAP for speed. -*/ - -extern "C" unsigned int nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2) -{ - nameKey_ptrToChar pi; - nameKey_ptrToChar pj; - char c1; - char c2; - - if (key1 == key2) - { - return TRUE; - } - else - { - pi = static_cast (nameKey_keyToCharStar (key1)); - pj = static_cast (nameKey_keyToCharStar (key2)); - c1 = (*pi); - c2 = (*pj); - while ((c1 != ASCII_nul) && (c2 != ASCII_nul)) - { - if (((c1 == c2) || (((c1 >= 'A') && (c1 <= 'Z')) && (c2 == ((char) (( ((unsigned int) (c1))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))))))) || (((c2 >= 'A') && (c2 <= 'Z')) && (c1 == ((char) (( ((unsigned int) (c2))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))))))) - { - pi += 1; - pj += 1; - c1 = (*pi); - c2 = (*pj); - } - else - { - /* difference found */ - return FALSE; - } - } - return c1 == c2; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - keyToCharStar - returns the C char * string equivalent for, key. -*/ - -extern "C" void * nameKey_keyToCharStar (nameKey_Name key) -{ - if ((key == nameKey_NulName) || (! (Indexing_InBounds (keyIndex, key)))) - { - return NULL; - } - else - { - return Indexing_GetIndice (keyIndex, key); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_nameKey_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - lastIndice = 0; - keyIndex = Indexing_InitIndex (1); - Storage_ALLOCATE ((void **) &binaryTree, sizeof (nameKey__T1)); - binaryTree->left = NULL; -} - -extern "C" void _M2_nameKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/GsymbolKey.c b/gcc/m2/mc-boot/GsymbolKey.c deleted file mode 100644 index 8c16a63474e5..000000000000 --- a/gcc/m2/mc-boot/GsymbolKey.c +++ /dev/null @@ -1,406 +0,0 @@ -/* do not edit automatically generated by mc from symbolKey. */ -/* symbolKey.mod provides binary tree operations for storing symbols. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _symbolKey_H -#define _symbolKey_C - -# include "GStorage.h" -# include "GStrIO.h" -# include "GNumberIO.h" -# include "GDebug.h" -# include "GnameKey.h" - -# define symbolKey_NulKey NULL -typedef struct symbolKey_isSymbol_p symbolKey_isSymbol; - -typedef struct symbolKey_performOperation_p symbolKey_performOperation; - -typedef struct symbolKey__T1_r symbolKey__T1; - -typedef symbolKey__T1 *symbolKey_symbolTree; - -typedef unsigned int (*symbolKey_isSymbol_t) (void *); -struct symbolKey_isSymbol_p { symbolKey_isSymbol_t proc; }; - -typedef void (*symbolKey_performOperation_t) (void *); -struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; }; - -struct symbolKey__T1_r { - nameKey_Name name; - void *key; - symbolKey_symbolTree left; - symbolKey_symbolTree right; - }; - -extern "C" symbolKey_symbolTree symbolKey_initTree (void); -extern "C" void symbolKey_killTree (symbolKey_symbolTree *t); -extern "C" void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name); -extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key); - -/* - delSymKey - deletes an entry in the binary tree. - - NB in order for this to work we must ensure that the InitTree sets - both left and right to NIL. -*/ - -extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name); - -/* - isEmptyTree - returns true if symbolTree, t, is empty. -*/ - -extern "C" unsigned int symbolKey_isEmptyTree (symbolKey_symbolTree t); - -/* - doesTreeContainAny - returns true if symbolTree, t, contains any - symbols which in turn return true when procedure, - p, is called with a symbol as its parameter. - The symbolTree root is empty apart from the field, - left, hence we need two procedures. -*/ - -extern "C" unsigned int symbolKey_doesTreeContainAny (symbolKey_symbolTree t, symbolKey_isSymbol p); - -/* - foreachNodeDo - for each node in symbolTree, t, a procedure, p, - is called with the node symbol as its parameter. - The tree root node only contains a legal left pointer, - therefore we need two procedures to examine this tree. -*/ - -extern "C" void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p); - -/* - findNodeAndParentInTree - find a node, child, in a binary tree, t, with name equal to n. - if an entry is found, father is set to the node above child. -*/ - -static void findNodeAndParentInTree (symbolKey_symbolTree t, nameKey_Name n, symbolKey_symbolTree *child, symbolKey_symbolTree *father); - -/* - searchForAny - performs the search required for doesTreeContainAny. - The root node always contains a nul data value, - therefore we must skip over it. -*/ - -static unsigned int searchForAny (symbolKey_symbolTree t, symbolKey_isSymbol p); - -/* - searchAndDo - searches all the nodes in symbolTree, t, and - calls procedure, p, with a node as its parameter. - It traverse the tree in order. -*/ - -static void searchAndDo (symbolKey_symbolTree t, symbolKey_performOperation p); - - -/* - findNodeAndParentInTree - find a node, child, in a binary tree, t, with name equal to n. - if an entry is found, father is set to the node above child. -*/ - -static void findNodeAndParentInTree (symbolKey_symbolTree t, nameKey_Name n, symbolKey_symbolTree *child, symbolKey_symbolTree *father) -{ - /* remember to skip the sentinal value and assign father and child */ - (*father) = t; - if (t == NULL) - { - Debug_Halt ((const char *) "parameter t should never be NIL", 31, 203, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44); - } - (*child) = t->left; - if ((*child) != NULL) - { - do { - if (n < (*child)->name) - { - (*father) = (*child); - (*child) = (*child)->left; - } - else if (n > (*child)->name) - { - /* avoid dangling else. */ - (*father) = (*child); - (*child) = (*child)->right; - } - } while (! (((*child) == NULL) || (n == (*child)->name))); - } -} - - -/* - searchForAny - performs the search required for doesTreeContainAny. - The root node always contains a nul data value, - therefore we must skip over it. -*/ - -static unsigned int searchForAny (symbolKey_symbolTree t, symbolKey_isSymbol p) -{ - if (t == NULL) - { - return FALSE; - } - else - { - return (((*p.proc) (t->key)) || (searchForAny (t->left, p))) || (searchForAny (t->right, p)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - searchAndDo - searches all the nodes in symbolTree, t, and - calls procedure, p, with a node as its parameter. - It traverse the tree in order. -*/ - -static void searchAndDo (symbolKey_symbolTree t, symbolKey_performOperation p) -{ - if (t != NULL) - { - searchAndDo (t->right, p); - (*p.proc) (t->key); - searchAndDo (t->left, p); - } -} - -extern "C" symbolKey_symbolTree symbolKey_initTree (void) -{ - symbolKey_symbolTree t; - - Storage_ALLOCATE ((void **) &t, sizeof (symbolKey__T1)); /* The value entity */ - t->left = NULL; - t->right = NULL; - return t; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void symbolKey_killTree (symbolKey_symbolTree *t) -{ - if ((*t) != NULL) - { - symbolKey_killTree (&(*t)->left); - symbolKey_killTree (&(*t)->right); - Storage_DEALLOCATE ((void **) &(*t), sizeof (symbolKey__T1)); - (*t) = NULL; - } -} - -extern "C" void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name) -{ - symbolKey_symbolTree father; - symbolKey_symbolTree child; - - if (t == NULL) - { - return symbolKey_NulKey; - } - else - { - findNodeAndParentInTree (t, name, &child, &father); - if (child == NULL) - { - return symbolKey_NulKey; - } - else - { - return child->key; - } - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key) -{ - symbolKey_symbolTree father; - symbolKey_symbolTree child; - - findNodeAndParentInTree (t, name, &child, &father); - if (child == NULL) - { - /* no child found, now is name less than father or greater? */ - if (father == t) - { - /* empty tree, add it to the left branch of t */ - Storage_ALLOCATE ((void **) &child, sizeof (symbolKey__T1)); - father->left = child; - } - else - { - if (name < father->name) - { - Storage_ALLOCATE ((void **) &child, sizeof (symbolKey__T1)); - father->left = child; - } - else if (name > father->name) - { - /* avoid dangling else. */ - Storage_ALLOCATE ((void **) &child, sizeof (symbolKey__T1)); - father->right = child; - } - } - child->right = NULL; - child->left = NULL; - child->key = key; - child->name = name; - } - else - { - Debug_Halt ((const char *) "symbol already stored", 21, 119, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44); - } -} - - -/* - delSymKey - deletes an entry in the binary tree. - - NB in order for this to work we must ensure that the InitTree sets - both left and right to NIL. -*/ - -extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name) -{ - symbolKey_symbolTree i; - symbolKey_symbolTree child; - symbolKey_symbolTree father; - - findNodeAndParentInTree (t, name, &child, &father); /* find father and child of the node */ - if ((child != NULL) && (child->name == name)) - { - /* Have found the node to be deleted */ - if (father->right == child) - { - /* most branch of child^.left. */ - if (child->left != NULL) - { - /* Scan for right most node of child^.left */ - i = child->left; - while (i->right != NULL) - { - i = i->right; - } - i->right = child->right; - father->right = child->left; - } - else - { - /* (as in a single linked list) to child^.right */ - father->right = child->right; - } - Storage_DEALLOCATE ((void **) &child, sizeof (symbolKey__T1)); - } - else - { - /* branch of child^.right */ - if (child->right != NULL) - { - /* Scan for left most node of child^.right */ - i = child->right; - while (i->left != NULL) - { - i = i->left; - } - i->left = child->left; - father->left = child->right; - } - else - { - /* (as in a single linked list) to child^.left. */ - father->left = child->left; - } - Storage_DEALLOCATE ((void **) &child, sizeof (symbolKey__T1)); - } - } - else - { - Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 186, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44); - } -} - - -/* - isEmptyTree - returns true if symbolTree, t, is empty. -*/ - -extern "C" unsigned int symbolKey_isEmptyTree (symbolKey_symbolTree t) -{ - return t->left == NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doesTreeContainAny - returns true if symbolTree, t, contains any - symbols which in turn return true when procedure, - p, is called with a symbol as its parameter. - The symbolTree root is empty apart from the field, - left, hence we need two procedures. -*/ - -extern "C" unsigned int symbolKey_doesTreeContainAny (symbolKey_symbolTree t, symbolKey_isSymbol p) -{ - return searchForAny (t->left, p); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - foreachNodeDo - for each node in symbolTree, t, a procedure, p, - is called with the node symbol as its parameter. - The tree root node only contains a legal left pointer, - therefore we need two procedures to examine this tree. -*/ - -extern "C" void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p) -{ - searchAndDo (t->left, p); -} - -extern "C" void _M2_symbolKey_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_symbolKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gtop.c b/gcc/m2/mc-boot/Gtop.c deleted file mode 100644 index 20c96133c20c..000000000000 --- a/gcc/m2/mc-boot/Gtop.c +++ /dev/null @@ -1,100 +0,0 @@ -/* do not edit automatically generated by mc from top. */ -/* top.mod main top level program module for mc. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# include "GmcOptions.h" -# include "GmcComp.h" -# include "GM2RTS.h" -# include "GmcStream.h" -# include "Glibc.h" - - -/* - wrapRemoveFiles - call removeFiles and return 0. -*/ - -static int wrapRemoveFiles (void); - -/* - init - translate the source file after handling all the - program arguments. -*/ - -static void init (void); - -/* - wrapRemoveFiles - call removeFiles and return 0. -*/ - -static int wrapRemoveFiles (void); - -/* - init - translate the source file after handling all the - program arguments. -*/ - -static void init (void); - - -/* - wrapRemoveFiles - call removeFiles and return 0. -*/ - -static int wrapRemoveFiles (void) -{ - mcStream_removeFiles (); - return 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - init - translate the source file after handling all the - program arguments. -*/ - -static void init (void) -{ - if ((libc_atexit ((libc_exitP_C) wrapRemoveFiles)) != 0) - { - libc_perror ((const char *) "atexit failed", 13); - } - M2RTS_ExitOnHalt (1); - mcComp_compile (mcOptions_handleOptions ()); -} - -extern "C" void _M2_top_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - init (); -} - -extern "C" void _M2_top_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gvarargs.c b/gcc/m2/mc-boot/Gvarargs.c deleted file mode 100644 index faf7f7703d87..000000000000 --- a/gcc/m2/mc-boot/Gvarargs.c +++ /dev/null @@ -1,431 +0,0 @@ -/* do not edit automatically generated by mc from varargs. */ -/* varargs.mod provides a basic vararg facility for GNU Modula-2. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _varargs_H -#define _varargs_C - -# include "GStorage.h" -# include "Glibc.h" -# include "GSYSTEM.h" -# include "GM2RTS.h" - -# define MaxArg 4 -typedef struct varargs_argDesc_r varargs_argDesc; - -typedef struct varargs__T6_r varargs__T6; - -typedef unsigned char *varargs_ptrToByte; - -typedef struct varargs__T7_a varargs__T7; - -typedef varargs__T6 *varargs_vararg; - -struct varargs_argDesc_r { - void *ptr; - unsigned int len; - }; - -struct varargs__T7_a { varargs_argDesc array[MaxArg+1]; }; -struct varargs__T6_r { - unsigned int nArgs; - unsigned int i; - void *contents; - unsigned int size; - varargs__T7 arg; - }; - - -/* - nargs - returns the number of arguments wrapped in, v. -*/ - -extern "C" unsigned int varargs_nargs (varargs_vararg v); - -/* - arg - fills in, a, with the next argument. The size of, a, must be an exact - match with the original vararg parameter. -*/ - -extern "C" void varargs_arg (varargs_vararg v, unsigned char *a, unsigned int _a_high); - -/* - next - assigns the next arg to be collected as, i. -*/ - -extern "C" void varargs_next (varargs_vararg v, unsigned int i); - -/* - copy - returns a copy of, v. -*/ - -extern "C" varargs_vararg varargs_copy (varargs_vararg v); - -/* - replace - fills the next argument with, a. The size of, a, - must be an exact match with the original vararg - parameter. -*/ - -extern "C" void varargs_replace (varargs_vararg v, unsigned char *a, unsigned int _a_high); - -/* - end - destructor for vararg, v. -*/ - -extern "C" void varargs_end (varargs_vararg *v); - -/* - start1 - wraps up argument, a, into a vararg. -*/ - -extern "C" varargs_vararg varargs_start1 (const unsigned char *a_, unsigned int _a_high); - -/* - start2 - wraps up arguments, a, b, into a vararg. -*/ - -extern "C" varargs_vararg varargs_start2 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high); - -/* - start3 - wraps up arguments, a, b, c, into a vararg. -*/ - -extern "C" varargs_vararg varargs_start3 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high, const unsigned char *c_, unsigned int _c_high); - -/* - start4 - wraps up arguments, a, b, c, d, into a vararg. -*/ - -extern "C" varargs_vararg varargs_start4 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high, const unsigned char *c_, unsigned int _c_high, const unsigned char *d_, unsigned int _d_high); - - -/* - nargs - returns the number of arguments wrapped in, v. -*/ - -extern "C" unsigned int varargs_nargs (varargs_vararg v) -{ - return v->nArgs; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - arg - fills in, a, with the next argument. The size of, a, must be an exact - match with the original vararg parameter. -*/ - -extern "C" void varargs_arg (varargs_vararg v, unsigned char *a, unsigned int _a_high) -{ - typedef unsigned char *arg__T1; - - arg__T1 p; - unsigned int j; - - if (v->i == v->nArgs) - { - M2RTS_HALT (-1); /* too many calls to arg. */ - __builtin_unreachable (); - } - else - { - if ((_a_high+1) == v->arg.array[v->i].len) - { - p = static_cast (v->arg.array[v->i].ptr); - j = 0; - while (j <= _a_high) - { - a[j] = (*p); - p += 1; - j += 1; - } - } - else - { - M2RTS_HALT (-1); /* parameter mismatch. */ - __builtin_unreachable (); - } - v->i += 1; - } -} - - -/* - next - assigns the next arg to be collected as, i. -*/ - -extern "C" void varargs_next (varargs_vararg v, unsigned int i) -{ - v->i = i; -} - - -/* - copy - returns a copy of, v. -*/ - -extern "C" varargs_vararg varargs_copy (varargs_vararg v) -{ - varargs_vararg c; - unsigned int j; - unsigned int offset; - - Storage_ALLOCATE ((void **) &c, sizeof (varargs__T6)); - c->i = v->i; - c->nArgs = v->nArgs; - c->size = v->size; - Storage_ALLOCATE (&c->contents, c->size); - c->contents = libc_memcpy (c->contents, v->contents, static_cast (c->size)); - for (j=0; j<=c->nArgs; j++) - { - offset = (unsigned int ) (((varargs_ptrToByte) (v->contents))-((varargs_ptrToByte) (v->arg.array[j].ptr))); - c->arg.array[j].ptr = reinterpret_cast ((varargs_ptrToByte) (((varargs_ptrToByte) (c->contents))+offset)); - c->arg.array[j].len = v->arg.array[j].len; - } - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - replace - fills the next argument with, a. The size of, a, - must be an exact match with the original vararg - parameter. -*/ - -extern "C" void varargs_replace (varargs_vararg v, unsigned char *a, unsigned int _a_high) -{ - typedef unsigned char *replace__T2; - - replace__T2 p; - unsigned int j; - - if (v->i == v->nArgs) - { - M2RTS_HALT (-1); /* too many calls to arg. */ - __builtin_unreachable (); - } - else - { - if ((_a_high+1) == v->arg.array[v->i].len) - { - p = static_cast (v->arg.array[v->i].ptr); - j = 0; - while (j <= _a_high) - { - (*p) = a[j]; - p += 1; - j += 1; - } - } - else - { - M2RTS_HALT (-1); /* parameter mismatch. */ - __builtin_unreachable (); - } - } -} - - -/* - end - destructor for vararg, v. -*/ - -extern "C" void varargs_end (varargs_vararg *v) -{ - if ((*v) != NULL) - { - Storage_DEALLOCATE (&(*v)->contents, sizeof (varargs_vararg)); - Storage_DEALLOCATE ((void **) &(*v), sizeof (varargs__T6)); - } -} - - -/* - start1 - wraps up argument, a, into a vararg. -*/ - -extern "C" varargs_vararg varargs_start1 (const unsigned char *a_, unsigned int _a_high) -{ - varargs_vararg v; - unsigned char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - Storage_ALLOCATE ((void **) &v, sizeof (varargs__T6)); - v->i = 0; - v->nArgs = 1; - v->size = _a_high+1; - Storage_ALLOCATE (&v->contents, v->size); - v->contents = libc_memcpy (v->contents, &a, static_cast (v->size)); - v->arg.array[0].ptr = v->contents; - v->arg.array[0].len = v->size; - return v; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - start2 - wraps up arguments, a, b, into a vararg. -*/ - -extern "C" varargs_vararg varargs_start2 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high) -{ - typedef unsigned char *start2__T3; - - varargs_vararg v; - start2__T3 p; - unsigned char a[_a_high+1]; - unsigned char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - Storage_ALLOCATE ((void **) &v, sizeof (varargs__T6)); - v->i = 0; - v->nArgs = 2; - v->size = (_a_high+_b_high)+2; - Storage_ALLOCATE (&v->contents, v->size); - p = static_cast (libc_memcpy (v->contents, &a, static_cast (_a_high+1))); - v->arg.array[0].ptr = reinterpret_cast (p); - v->arg.array[0].len = _a_high+1; - p += v->arg.array[0].len; - p = static_cast (libc_memcpy (reinterpret_cast (p), &b, static_cast (_b_high+1))); - v->arg.array[1].ptr = reinterpret_cast (p); - v->arg.array[1].len = _b_high+1; - return v; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - start3 - wraps up arguments, a, b, c, into a vararg. -*/ - -extern "C" varargs_vararg varargs_start3 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high, const unsigned char *c_, unsigned int _c_high) -{ - typedef unsigned char *start3__T4; - - varargs_vararg v; - start3__T4 p; - unsigned char a[_a_high+1]; - unsigned char b[_b_high+1]; - unsigned char c[_c_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - memcpy (c, c_, _c_high+1); - - Storage_ALLOCATE ((void **) &v, sizeof (varargs__T6)); - v->i = 0; - v->nArgs = 3; - v->size = ((_a_high+_b_high)+_c_high)+3; - Storage_ALLOCATE (&v->contents, v->size); - p = static_cast (libc_memcpy (v->contents, &a, static_cast (_a_high+1))); - v->arg.array[0].ptr = reinterpret_cast (p); - v->arg.array[0].len = _a_high+1; - p += v->arg.array[0].len; - p = static_cast (libc_memcpy (reinterpret_cast (p), &b, static_cast (_b_high+1))); - v->arg.array[1].ptr = reinterpret_cast (p); - v->arg.array[1].len = _b_high+1; - p += v->arg.array[1].len; - p = static_cast (libc_memcpy (reinterpret_cast (p), &c, static_cast (_c_high+1))); - v->arg.array[2].ptr = reinterpret_cast (p); - v->arg.array[2].len = _c_high+1; - return v; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - start4 - wraps up arguments, a, b, c, d, into a vararg. -*/ - -extern "C" varargs_vararg varargs_start4 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high, const unsigned char *c_, unsigned int _c_high, const unsigned char *d_, unsigned int _d_high) -{ - typedef unsigned char *start4__T5; - - varargs_vararg v; - start4__T5 p; - unsigned char a[_a_high+1]; - unsigned char b[_b_high+1]; - unsigned char c[_c_high+1]; - unsigned char d[_d_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - memcpy (c, c_, _c_high+1); - memcpy (d, d_, _d_high+1); - - Storage_ALLOCATE ((void **) &v, sizeof (varargs__T6)); - v->i = 0; - v->nArgs = 4; - v->size = (((_a_high+_b_high)+_c_high)+_d_high)+4; - Storage_ALLOCATE (&v->contents, v->size); - p = static_cast (libc_memcpy (v->contents, &a, static_cast (_a_high+1))); - v->arg.array[0].len = _a_high+1; - p += v->arg.array[0].len; - p = static_cast (libc_memcpy (reinterpret_cast (p), &b, static_cast (_b_high+1))); - v->arg.array[1].ptr = reinterpret_cast (p); - v->arg.array[1].len = _b_high+1; - p += v->arg.array[1].len; - p = static_cast (libc_memcpy (reinterpret_cast (p), &c, static_cast (_c_high+1))); - v->arg.array[2].ptr = reinterpret_cast (p); - v->arg.array[2].len = _c_high+1; - p += v->arg.array[2].len; - p = static_cast (libc_memcpy (reinterpret_cast (p), &c, static_cast (_c_high+1))); - v->arg.array[3].ptr = reinterpret_cast (p); - v->arg.array[3].len = _c_high+1; - return v; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_varargs_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_varargs_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/mc-boot/Gwlists.c b/gcc/m2/mc-boot/Gwlists.c deleted file mode 100644 index c8daafd4ff8f..000000000000 --- a/gcc/m2/mc-boot/Gwlists.c +++ /dev/null @@ -1,471 +0,0 @@ -/* do not edit automatically generated by mc from wlists. */ -/* wlists.mod word lists module. - -Copyright (C) 2015-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _wlists_H -#define _wlists_C - -# include "GStorage.h" - -typedef struct wlists_performOperation_p wlists_performOperation; - -# define maxNoOfElements 5 -typedef struct wlists__T1_r wlists__T1; - -typedef struct wlists__T2_a wlists__T2; - -typedef wlists__T1 *wlists_wlist; - -typedef void (*wlists_performOperation_t) (unsigned int); -struct wlists_performOperation_p { wlists_performOperation_t proc; }; - -struct wlists__T2_a { unsigned int array[maxNoOfElements-1+1]; }; -struct wlists__T1_r { - unsigned int noOfElements; - wlists__T2 elements; - wlists_wlist next; - }; - - -/* - initList - creates a new wlist, l. -*/ - -extern "C" wlists_wlist wlists_initList (void); - -/* - killList - deletes the complete wlist, l. -*/ - -extern "C" void wlists_killList (wlists_wlist *l); - -/* - putItemIntoList - places an WORD, c, into wlist, l. -*/ - -extern "C" void wlists_putItemIntoList (wlists_wlist l, unsigned int c); - -/* - getItemFromList - retrieves the nth WORD from wlist, l. -*/ - -extern "C" unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n); - -/* - getIndexOfList - returns the index for WORD, c, in wlist, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c); - -/* - noOfItemsInList - returns the number of items in wlist, l. -*/ - -extern "C" unsigned int wlists_noOfItemsInList (wlists_wlist l); - -/* - includeItemIntoList - adds an WORD, c, into a wlist providing - the value does not already exist. -*/ - -extern "C" void wlists_includeItemIntoList (wlists_wlist l, unsigned int c); - -/* - removeItemFromList - removes a WORD, c, from a wlist. - It assumes that this value only appears once. -*/ - -extern "C" void wlists_removeItemFromList (wlists_wlist l, unsigned int c); - -/* - replaceItemInList - replace the nth WORD in wlist, l. - The first item in a wlists is at index, 1. - If the index, n, is out of range nothing is changed. -*/ - -extern "C" void wlists_replaceItemInList (wlists_wlist l, unsigned int n, unsigned int w); - -/* - isItemInList - returns true if a WORD, c, was found in wlist, l. -*/ - -extern "C" unsigned int wlists_isItemInList (wlists_wlist l, unsigned int c); - -/* - foreachItemInListDo - calls procedure, P, foreach item in wlist, l. -*/ - -extern "C" void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p); - -/* - duplicateList - returns a duplicate wlist derived from, l. -*/ - -extern "C" wlists_wlist wlists_duplicateList (wlists_wlist l); - -/* - removeItem - remove an element at index, i, from the wlist data type. -*/ - -static void removeItem (wlists_wlist p, wlists_wlist l, unsigned int i); - - -/* - removeItem - remove an element at index, i, from the wlist data type. -*/ - -static void removeItem (wlists_wlist p, wlists_wlist l, unsigned int i) -{ - l->noOfElements -= 1; - while (i <= l->noOfElements) - { - l->elements.array[i-1] = l->elements.array[i+1-1]; - i += 1; - } - if ((l->noOfElements == 0) && (p != NULL)) - { - p->next = l->next; - Storage_DEALLOCATE ((void **) &l, sizeof (wlists__T1)); - } -} - - -/* - initList - creates a new wlist, l. -*/ - -extern "C" wlists_wlist wlists_initList (void) -{ - wlists_wlist l; - - Storage_ALLOCATE ((void **) &l, sizeof (wlists__T1)); - l->noOfElements = 0; - l->next = NULL; - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - killList - deletes the complete wlist, l. -*/ - -extern "C" void wlists_killList (wlists_wlist *l) -{ - if ((*l) != NULL) - { - if ((*l)->next != NULL) - { - wlists_killList (&(*l)->next); - } - Storage_DEALLOCATE ((void **) &(*l), sizeof (wlists__T1)); - } -} - - -/* - putItemIntoList - places an WORD, c, into wlist, l. -*/ - -extern "C" void wlists_putItemIntoList (wlists_wlist l, unsigned int c) -{ - if (l->noOfElements < maxNoOfElements) - { - l->noOfElements += 1; - l->elements.array[l->noOfElements-1] = c; - } - else if (l->next != NULL) - { - /* avoid dangling else. */ - wlists_putItemIntoList (l->next, c); - } - else - { - /* avoid dangling else. */ - l->next = wlists_initList (); - wlists_putItemIntoList (l->next, c); - } -} - - -/* - getItemFromList - retrieves the nth WORD from wlist, l. -*/ - -extern "C" unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n) -{ - while (l != NULL) - { - if (n <= l->noOfElements) - { - return l->elements.array[n-1]; - } - else - { - n -= l->noOfElements; - } - l = l->next; - } - return static_cast (0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getIndexOfList - returns the index for WORD, c, in wlist, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c) -{ - unsigned int i; - - if (l == NULL) - { - return 0; - } - else - { - i = 1; - while (i <= l->noOfElements) - { - if (l->elements.array[i-1] == c) - { - return i; - } - else - { - i += 1; - } - } - return l->noOfElements+(wlists_getIndexOfList (l->next, c)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - noOfItemsInList - returns the number of items in wlist, l. -*/ - -extern "C" unsigned int wlists_noOfItemsInList (wlists_wlist l) -{ - unsigned int t; - - if (l == NULL) - { - return 0; - } - else - { - t = 0; - do { - t += l->noOfElements; - l = l->next; - } while (! (l == NULL)); - return t; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - includeItemIntoList - adds an WORD, c, into a wlist providing - the value does not already exist. -*/ - -extern "C" void wlists_includeItemIntoList (wlists_wlist l, unsigned int c) -{ - if (! (wlists_isItemInList (l, c))) - { - wlists_putItemIntoList (l, c); - } -} - - -/* - removeItemFromList - removes a WORD, c, from a wlist. - It assumes that this value only appears once. -*/ - -extern "C" void wlists_removeItemFromList (wlists_wlist l, unsigned int c) -{ - wlists_wlist p; - unsigned int i; - unsigned int found; - - if (l != NULL) - { - found = FALSE; - p = NULL; - do { - i = 1; - while ((i <= l->noOfElements) && (l->elements.array[i-1] != c)) - { - i += 1; - } - if ((i <= l->noOfElements) && (l->elements.array[i-1] == c)) - { - found = TRUE; - } - else - { - p = l; - l = l->next; - } - } while (! ((l == NULL) || found)); - if (found) - { - removeItem (p, l, i); - } - } -} - - -/* - replaceItemInList - replace the nth WORD in wlist, l. - The first item in a wlists is at index, 1. - If the index, n, is out of range nothing is changed. -*/ - -extern "C" void wlists_replaceItemInList (wlists_wlist l, unsigned int n, unsigned int w) -{ - while (l != NULL) - { - if (n <= l->noOfElements) - { - l->elements.array[n-1] = w; - } - else - { - n -= l->noOfElements; - } - l = l->next; - } -} - - -/* - isItemInList - returns true if a WORD, c, was found in wlist, l. -*/ - -extern "C" unsigned int wlists_isItemInList (wlists_wlist l, unsigned int c) -{ - unsigned int i; - - do { - i = 1; - while (i <= l->noOfElements) - { - if (l->elements.array[i-1] == c) - { - return TRUE; - } - else - { - i += 1; - } - } - l = l->next; - } while (! (l == NULL)); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - foreachItemInListDo - calls procedure, P, foreach item in wlist, l. -*/ - -extern "C" void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p) -{ - unsigned int i; - unsigned int n; - - n = wlists_noOfItemsInList (l); - i = 1; - while (i <= n) - { - (*p.proc) (wlists_getItemFromList (l, i)); - i += 1; - } -} - - -/* - duplicateList - returns a duplicate wlist derived from, l. -*/ - -extern "C" wlists_wlist wlists_duplicateList (wlists_wlist l) -{ - wlists_wlist m; - unsigned int n; - unsigned int i; - - m = wlists_initList (); - n = wlists_noOfItemsInList (l); - i = 1; - while (i <= n) - { - wlists_putItemIntoList (m, wlists_getItemFromList (l, i)); - i += 1; - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_wlists_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_wlists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GASCII.c b/gcc/m2/pge-boot/GASCII.c deleted file mode 100644 index 077cdffb6136..000000000000 --- a/gcc/m2/pge-boot/GASCII.c +++ /dev/null @@ -1,84 +0,0 @@ -/* do not edit automatically generated by mc from ASCII. */ -/* ASCII.mod dummy companion module for the definition. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _ASCII_H -#define _ASCII_C - - -# define ASCII_nul (char) 000 -# define ASCII_soh (char) 001 -# define ASCII_stx (char) 002 -# define ASCII_etx (char) 003 -# define ASCII_eot (char) 004 -# define ASCII_enq (char) 005 -# define ASCII_ack (char) 006 -# define ASCII_bel (char) 007 -# define ASCII_bs (char) 010 -# define ASCII_ht (char) 011 -# define ASCII_nl (char) 012 -# define ASCII_vt (char) 013 -# define ASCII_np (char) 014 -# define ASCII_cr (char) 015 -# define ASCII_so (char) 016 -# define ASCII_si (char) 017 -# define ASCII_dle (char) 020 -# define ASCII_dc1 (char) 021 -# define ASCII_dc2 (char) 022 -# define ASCII_dc3 (char) 023 -# define ASCII_dc4 (char) 024 -# define ASCII_nak (char) 025 -# define ASCII_syn (char) 026 -# define ASCII_etb (char) 027 -# define ASCII_can (char) 030 -# define ASCII_em (char) 031 -# define ASCII_sub (char) 032 -# define ASCII_esc (char) 033 -# define ASCII_fs (char) 034 -# define ASCII_gs (char) 035 -# define ASCII_rs (char) 036 -# define ASCII_us (char) 037 -# define ASCII_sp (char) 040 -# define ASCII_lf ASCII_nl -# define ASCII_ff ASCII_np -# define ASCII_eof ASCII_eot -# define ASCII_tab ASCII_ht -# define ASCII_del (char) 0177 -# define ASCII_EOL ASCII_nl - -extern "C" void _M2_ASCII_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_ASCII_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GArgs.c b/gcc/m2/pge-boot/GArgs.c deleted file mode 100644 index 819a46f28062..000000000000 --- a/gcc/m2/pge-boot/GArgs.c +++ /dev/null @@ -1,118 +0,0 @@ -/* do not edit automatically generated by mc from Args. */ -/* Args.mod provide access to command line arguments. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _Args_H -#define _Args_C - -# include "GUnixArgs.h" -# include "GASCII.h" - -# define MaxArgs 255 -# define MaxString 4096 -typedef struct Args__T2_a Args__T2; - -typedef Args__T2 *Args__T1; - -typedef struct Args__T3_a Args__T3; - -struct Args__T2_a { Args__T3 * array[MaxArgs+1]; }; -struct Args__T3_a { char array[MaxString+1]; }; -static Args__T1 Source; - -/* - GetArg - returns the nth argument from the command line. - The success of the operation is returned. -*/ - -extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n); - -/* - Narg - returns the number of arguments available from - command line. -*/ - -extern "C" unsigned int Args_Narg (void); - - -/* - GetArg - returns the nth argument from the command line. - The success of the operation is returned. -*/ - -extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n) -{ - int i; - unsigned int High; - unsigned int j; - - i = (int ) (n); - j = 0; - High = _a_high; - if (i < (UnixArgs_GetArgC ())) - { - Source = static_cast (UnixArgs_GetArgV ()); - while ((j < High) && ((*(*Source).array[i]).array[j] != ASCII_nul)) - { - a[j] = (*(*Source).array[i]).array[j]; - j += 1; - } - } - if (j <= High) - { - a[j] = ASCII_nul; - } - return i < (UnixArgs_GetArgC ()); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Narg - returns the number of arguments available from - command line. -*/ - -extern "C" unsigned int Args_Narg (void) -{ - return UnixArgs_GetArgC (); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_Args_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Args_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GAssertion.c b/gcc/m2/pge-boot/GAssertion.c deleted file mode 100644 index 5088db4068da..000000000000 --- a/gcc/m2/pge-boot/GAssertion.c +++ /dev/null @@ -1,69 +0,0 @@ -/* do not edit automatically generated by mc from Assertion. */ -/* Assertion.mod provides an assert procedure. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _Assertion_H -#define _Assertion_C - -# include "GStrIO.h" -# include "GM2RTS.h" - - -/* - Assert - tests the boolean Condition, if it fails then HALT is called. -*/ - -extern "C" void Assertion_Assert (unsigned int Condition); - - -/* - Assert - tests the boolean Condition, if it fails then HALT is called. -*/ - -extern "C" void Assertion_Assert (unsigned int Condition) -{ - if (! Condition) - { - StrIO_WriteString ((const char *) "assert failed - halting system", 30); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - -extern "C" void _M2_Assertion_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Assertion_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GBuiltins.c b/gcc/m2/pge-boot/GBuiltins.c deleted file mode 100644 index 30b07e3a9c26..000000000000 --- a/gcc/m2/pge-boot/GBuiltins.c +++ /dev/null @@ -1,43 +0,0 @@ -/* GBuiltins.c dummy module to aid linking mc projects. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#if defined(__cplusplus) -#define EXTERN extern "C" -#else -#define EXTERN -#endif - - -/* init module constructor. */ - -EXTERN -void -_M2_Builtins_init (void) -{ -} - -/* finish module deconstructor. */ - -EXTERN -void -_M2_Builtins_finish (void) -{ -} diff --git a/gcc/m2/pge-boot/GDebug.c b/gcc/m2/pge-boot/GDebug.c deleted file mode 100644 index 431068492ee4..000000000000 --- a/gcc/m2/pge-boot/GDebug.c +++ /dev/null @@ -1,168 +0,0 @@ -/* do not edit automatically generated by mc from Debug. */ -/* Debug.mod provides some simple debugging routines. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#include -#include -#define _Debug_H -#define _Debug_C - -# include "GASCII.h" -# include "GNumberIO.h" -# include "GStdIO.h" -# include "Glibc.h" -# include "GM2RTS.h" - -# define MaxNoOfDigits 12 - -/* - Halt - writes a message in the format: - Module:Line:Message - - It then terminates by calling HALT. -*/ - -extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high); - -/* - DebugString - writes a string to the debugging device (Scn.Write). - It interprets - as carriage return, linefeed. -*/ - -extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high); - -/* - WriteLn - writes a carriage return and a newline - character. -*/ - -static void WriteLn (void); - - -/* - WriteLn - writes a carriage return and a newline - character. -*/ - -static void WriteLn (void) -{ - StdIO_Write (ASCII_cr); - StdIO_Write (ASCII_lf); -} - - -/* - Halt - writes a message in the format: - Module:Line:Message - - It then terminates by calling HALT. -*/ - -extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high) -{ - typedef struct Halt__T1_a Halt__T1; - - struct Halt__T1_a { char array[MaxNoOfDigits+1]; }; - Halt__T1 No; - char Message[_Message_high+1]; - char Module[_Module_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (Message, Message_, _Message_high+1); - memcpy (Module, Module_, _Module_high+1); - - Debug_DebugString ((const char *) Module, _Module_high); /* should be large enough for most source files.. */ - NumberIO_CardToStr (LineNo, 0, (char *) &No.array[0], MaxNoOfDigits); - Debug_DebugString ((const char *) ":", 1); - Debug_DebugString ((const char *) &No.array[0], MaxNoOfDigits); - Debug_DebugString ((const char *) ":", 1); - Debug_DebugString ((const char *) Message, _Message_high); - Debug_DebugString ((const char *) "\\n", 2); - M2RTS_HALT (-1); - __builtin_unreachable (); -} - - -/* - DebugString - writes a string to the debugging device (Scn.Write). - It interprets - as carriage return, linefeed. -*/ - -extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high) -{ - unsigned int n; - unsigned int high; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - high = _a_high; - n = 0; - while ((n <= high) && (a[n] != ASCII_nul)) - { - if (a[n] == '\\') - { - /* avoid dangling else. */ - if ((n+1) <= high) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (a[n+1] == 'n') - { - WriteLn (); - n += 1; - } - else if (a[n+1] == '\\') - { - /* avoid dangling else. */ - StdIO_Write ('\\'); - n += 1; - } - } - } - else - { - StdIO_Write (a[n]); - } - n += 1; - } -} - -extern "C" void _M2_Debug_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Debug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GDynamicStrings.c b/gcc/m2/pge-boot/GDynamicStrings.c deleted file mode 100644 index 2dd4985b47ed..000000000000 --- a/gcc/m2/pge-boot/GDynamicStrings.c +++ /dev/null @@ -1,2679 +0,0 @@ -/* do not edit automatically generated by mc from DynamicStrings. */ -/* DynamicStrings.mod provides a dynamic string type and procedures. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -#include -# include "GStorage.h" -#include -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _DynamicStrings_H -#define _DynamicStrings_C - -# include "Glibc.h" -# include "GStrLib.h" -# include "GStorage.h" -# include "GAssertion.h" -# include "GSYSTEM.h" -# include "GASCII.h" -# include "GM2RTS.h" - -# define MaxBuf 127 -# define PoisonOn FALSE -# define DebugOn FALSE -# define CheckOn FALSE -# define TraceOn FALSE -typedef struct DynamicStrings_Contents_r DynamicStrings_Contents; - -typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo; - -typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord; - -typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor; - -typedef DynamicStrings_descriptor *DynamicStrings_Descriptor; - -typedef struct DynamicStrings_frameRec_r DynamicStrings_frameRec; - -typedef DynamicStrings_frameRec *DynamicStrings_frame; - -typedef struct DynamicStrings__T3_a DynamicStrings__T3; - -typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState; - -typedef DynamicStrings_stringRecord *DynamicStrings_String; - -struct DynamicStrings_DebugInfo_r { - DynamicStrings_String next; - void *file; - unsigned int line; - void *proc; - }; - -struct DynamicStrings_descriptor_r { - unsigned int charStarUsed; - void *charStar; - unsigned int charStarSize; - unsigned int charStarValid; - DynamicStrings_desState state; - DynamicStrings_String garbage; - }; - -struct DynamicStrings_frameRec_r { - DynamicStrings_String alloc; - DynamicStrings_String dealloc; - DynamicStrings_frame next; - }; - -struct DynamicStrings__T3_a { char array[(MaxBuf-1)+1]; }; -struct DynamicStrings_Contents_r { - DynamicStrings__T3 buf; - unsigned int len; - DynamicStrings_String next; - }; - -struct DynamicStrings_stringRecord_r { - DynamicStrings_Contents contents; - DynamicStrings_Descriptor head; - DynamicStrings_DebugInfo debug; - }; - -static unsigned int Initialized; -static DynamicStrings_frame frameHead; -static DynamicStrings_String captured; - -/* - InitString - creates and returns a String type object. - Initial contents are, a. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high); - -/* - KillString - frees String, s, and its contents. - NIL is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s); - -/* - Fin - finishes with a string, it calls KillString with, s. - The purpose of the procedure is to provide a short cut - to calling KillString and then testing the return result. -*/ - -extern "C" void DynamicStrings_Fin (DynamicStrings_String s); - -/* - InitStringCharStar - initializes and returns a String to contain the C string. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a); - -/* - InitStringChar - initializes and returns a String to contain the single character, ch. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch); - -/* - Mark - marks String, s, ready for garbage collection. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s); - -/* - Length - returns the length of the String, s. -*/ - -extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s); - -/* - ConCat - returns String, a, after the contents of, b, have been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b); - -/* - ConCatChar - returns String, a, after character, ch, has been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch); - -/* - Assign - assigns the contents of, b, into, a. - String, a, is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b); - -/* - Dup - duplicate a String, s, returning the copy of s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s); - -/* - Add - returns a new String which contains the contents of a and b. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b); - -/* - Equal - returns TRUE if String, a, and, b, are equal. -*/ - -extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b); - -/* - EqualCharStar - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a); - -/* - EqualArray - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high); - -/* - Mult - returns a new string which is n concatenations of String, s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n); - -/* - Slice - returns a new string which contains the elements - low..high-1 - - strings start at element 0 - Slice(s, 0, 2) will return elements 0, 1 but not 2 - Slice(s, 1, 3) will return elements 1, 2 but not 3 - Slice(s, 2, 0) will return elements 2..max - Slice(s, 3, -1) will return elements 3..max-1 - Slice(s, 4, -2) will return elements 4..max-2 -*/ - -extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high); - -/* - Index - returns the indice of the first occurance of, ch, in - String, s. -1 is returned if, ch, does not exist. - The search starts at position, o. -*/ - -extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o); - -/* - RIndex - returns the indice of the last occurance of, ch, - in String, s. The search starts at position, o. - -1 is returned if, ch, is not found. -*/ - -extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o); - -/* - RemoveComment - assuming that, comment, is a comment delimiter - which indicates anything to its right is a comment - then strip off the comment and also any white space - on the remaining right hand side. - It leaves any white space on the left hand side alone. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment); - -/* - RemoveWhitePrefix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s); - -/* - RemoveWhitePostfix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s); - -/* - ToUpper - returns string, s, after it has had its lower case characters - replaced by upper case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s); - -/* - ToLower - returns string, s, after it has had its upper case characters - replaced by lower case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s); - -/* - CopyOut - copies string, s, to a. -*/ - -extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s); - -/* - char - returns the character, ch, at position, i, in String, s. -*/ - -extern "C" char DynamicStrings_char (DynamicStrings_String s, int i); - -/* - string - returns the C style char * of String, s. -*/ - -extern "C" void * DynamicStrings_string (DynamicStrings_String s); - -/* - InitStringDB - the debug version of InitString. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line); - -/* - InitStringCharStarDB - the debug version of InitStringCharStar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line); - -/* - InitStringCharDB - the debug version of InitStringChar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line); - -/* - MultDB - the debug version of MultDB. -*/ - -extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line); - -/* - DupDB - the debug version of Dup. -*/ - -extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line); - -/* - SliceDB - debug version of Slice. -*/ - -extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line); - -/* - PushAllocation - pushes the current allocation/deallocation lists. -*/ - -extern "C" void DynamicStrings_PushAllocation (void); - -/* - PopAllocation - test to see that all strings are deallocated since - the last push. Then it pops to the previous - allocation/deallocation lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" void DynamicStrings_PopAllocation (unsigned int halt); - -/* - PopAllocationExemption - test to see that all strings are deallocated, except - string, e, since the last push. - Then it pops to the previous allocation/deallocation - lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e); - -/* - writeStringDesc write out debugging information about string, s. */ - -static void writeStringDesc (DynamicStrings_String s); - -/* - writeNspace - -*/ - -static void writeNspace (unsigned int n); - -/* - DumpStringInfo - -*/ - -static void DumpStringInfo (DynamicStrings_String s, unsigned int i); - -/* - DumpStringInfo - -*/ - -static void stop (void); - -/* - doDSdbEnter - -*/ - -static void doDSdbEnter (void); - -/* - doDSdbExit - -*/ - -static void doDSdbExit (DynamicStrings_String s); - -/* - DSdbEnter - -*/ - -static void DSdbEnter (void); - -/* - DSdbExit - -*/ - -static void DSdbExit (DynamicStrings_String s); -static unsigned int Capture (DynamicStrings_String s); - -/* - Min - -*/ - -static unsigned int Min (unsigned int a, unsigned int b); - -/* - Max - -*/ - -static unsigned int Max (unsigned int a, unsigned int b); - -/* - writeString - writes a string to stdout. -*/ - -static void writeString (const char *a_, unsigned int _a_high); - -/* - writeCstring - writes a C string to stdout. -*/ - -static void writeCstring (void * a); - -/* - writeCard - -*/ - -static void writeCard (unsigned int c); - -/* - writeLongcard - -*/ - -static void writeLongcard (long unsigned int l); - -/* - writeAddress - -*/ - -static void writeAddress (void * a); - -/* - writeLn - writes a newline. -*/ - -static void writeLn (void); - -/* - AssignDebug - assigns, file, and, line, information to string, s. -*/ - -static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high); - -/* - IsOn - returns TRUE if, s, is on one of the debug lists. -*/ - -static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s); - -/* - AddTo - adds string, s, to, list. -*/ - -static void AddTo (DynamicStrings_String *list, DynamicStrings_String s); - -/* - SubFrom - removes string, s, from, list. -*/ - -static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s); - -/* - AddAllocated - adds string, s, to the head of the allocated list. -*/ - -static void AddAllocated (DynamicStrings_String s); - -/* - AddDeallocated - adds string, s, to the head of the deallocated list. -*/ - -static void AddDeallocated (DynamicStrings_String s); - -/* - IsOnAllocated - returns TRUE if the string, s, has ever been allocated. -*/ - -static unsigned int IsOnAllocated (DynamicStrings_String s); - -/* - IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated. -*/ - -static unsigned int IsOnDeallocated (DynamicStrings_String s); - -/* - SubAllocated - removes string, s, from the list of allocated strings. -*/ - -static void SubAllocated (DynamicStrings_String s); - -/* - SubDeallocated - removes string, s, from the list of deallocated strings. -*/ - -static void SubDeallocated (DynamicStrings_String s); - -/* - SubDebugInfo - removes string, s, from the list of allocated strings. -*/ - -static void SubDebugInfo (DynamicStrings_String s); - -/* - AddDebugInfo - adds string, s, to the list of allocated strings. -*/ - -static void AddDebugInfo (DynamicStrings_String s); - -/* - ConcatContents - add the contents of string, a, where, h, is the - total length of, a. The offset is in, o. -*/ - -static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o); - -/* - DeallocateCharStar - deallocates any charStar. -*/ - -static void DeallocateCharStar (DynamicStrings_String s); - -/* - CheckPoisoned - checks for a poisoned string, s. -*/ - -static DynamicStrings_String CheckPoisoned (DynamicStrings_String s); - -/* - MarkInvalid - marks the char * version of String, s, as invalid. -*/ - -static void MarkInvalid (DynamicStrings_String s); - -/* - ConcatContentsAddress - concatenate the string, a, where, h, is the - total length of, a. -*/ - -static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h); - -/* - AddToGarbage - adds String, b, onto the garbage list of, a. Providing - the state of b is marked. The state is then altered to - onlist. String, a, is returned. -*/ - -static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b); - -/* - IsOnGarbage - returns TRUE if, s, is on string, e, garbage list. -*/ - -static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s); - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch); - -/* - DumpState - -*/ - -static void DumpState (DynamicStrings_String s); - -/* - DumpStringSynopsis - -*/ - -static void DumpStringSynopsis (DynamicStrings_String s); - -/* - DumpString - displays the contents of string, s. -*/ - -static void DumpString (DynamicStrings_String s); - -/* - Init - initialize the module. -*/ - -static void Init (void); - - -/* - writeStringDesc write out debugging information about string, s. */ - -static void writeStringDesc (DynamicStrings_String s) -{ - writeCstring (s->debug.file); - writeString ((const char *) ":", 1); - writeCard (s->debug.line); - writeString ((const char *) ":", 1); - writeCstring (s->debug.proc); - writeString ((const char *) " ", 1); - writeAddress (reinterpret_cast (s)); - writeString ((const char *) " ", 1); - switch (s->head->state) - { - case DynamicStrings_inuse: - writeString ((const char *) "still in use (", 14); - writeCard (s->contents.len); - writeString ((const char *) ") characters", 12); - break; - - case DynamicStrings_marked: - writeString ((const char *) "marked", 6); - break; - - case DynamicStrings_onlist: - writeString ((const char *) "on a (lost) garbage list", 24); - break; - - case DynamicStrings_poisoned: - writeString ((const char *) "poisoned", 8); - break; - - - default: - writeString ((const char *) "unknown state", 13); - break; - } -} - - -/* - writeNspace - -*/ - -static void writeNspace (unsigned int n) -{ - while (n > 0) - { - writeString ((const char *) " ", 1); - n -= 1; - } -} - - -/* - DumpStringInfo - -*/ - -static void DumpStringInfo (DynamicStrings_String s, unsigned int i) -{ - DynamicStrings_String t; - - if (s != NULL) - { - writeNspace (i); - writeStringDesc (s); - writeLn (); - if (s->head->garbage != NULL) - { - writeNspace (i); - writeString ((const char *) "garbage list:", 13); - writeLn (); - do { - s = s->head->garbage; - DumpStringInfo (s, i+1); - writeLn (); - } while (! (s == NULL)); - } - } -} - - -/* - DumpStringInfo - -*/ - -static void stop (void) -{ -} - - -/* - doDSdbEnter - -*/ - -static void doDSdbEnter (void) -{ - if (CheckOn) - { - DynamicStrings_PushAllocation (); - } -} - - -/* - doDSdbExit - -*/ - -static void doDSdbExit (DynamicStrings_String s) -{ - if (CheckOn) - { - s = DynamicStrings_PopAllocationExemption (TRUE, s); - } -} - - -/* - DSdbEnter - -*/ - -static void DSdbEnter (void) -{ -} - - -/* - DSdbExit - -*/ - -static void DSdbExit (DynamicStrings_String s) -{ -} - -static unsigned int Capture (DynamicStrings_String s) -{ - /* - * #undef GM2_DEBUG_DYNAMICSTINGS - * #if defined(GM2_DEBUG_DYNAMICSTINGS) - * # define DSdbEnter doDSdbEnter - * # define DSdbExit doDSdbExit - * # define CheckOn TRUE - * # define TraceOn TRUE - * #endif - */ - captured = s; - return 1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Min - -*/ - -static unsigned int Min (unsigned int a, unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Max - -*/ - -static unsigned int Max (unsigned int a, unsigned int b) -{ - if (a > b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - writeString - writes a string to stdout. -*/ - -static void writeString (const char *a_, unsigned int _a_high) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = static_cast (libc_write (1, &a, static_cast (StrLib_StrLen ((const char *) a, _a_high)))); -} - - -/* - writeCstring - writes a C string to stdout. -*/ - -static void writeCstring (void * a) -{ - int i; - - if (a == NULL) - { - writeString ((const char *) "(null)", 6); - } - else - { - i = static_cast (libc_write (1, a, libc_strlen (a))); - } -} - - -/* - writeCard - -*/ - -static void writeCard (unsigned int c) -{ - char ch; - int i; - - if (c > 9) - { - writeCard (c / 10); - writeCard (c % 10); - } - else - { - ch = ((char) ( ((unsigned int) ('0'))+c)); - i = static_cast (libc_write (1, &ch, static_cast (1))); - } -} - - -/* - writeLongcard - -*/ - -static void writeLongcard (long unsigned int l) -{ - char ch; - int i; - - if (l > 16) - { - writeLongcard (l / 16); - writeLongcard (l % 16); - } - else if (l < 10) - { - /* avoid dangling else. */ - ch = ((char) ( ((unsigned int) ('0'))+((unsigned int ) (l)))); - i = static_cast (libc_write (1, &ch, static_cast (1))); - } - else if (l < 16) - { - /* avoid dangling else. */ - ch = ((char) (( ((unsigned int) ('a'))+((unsigned int ) (l)))-10)); - i = static_cast (libc_write (1, &ch, static_cast (1))); - } -} - - -/* - writeAddress - -*/ - -static void writeAddress (void * a) -{ - writeLongcard ((long unsigned int ) (a)); -} - - -/* - writeLn - writes a newline. -*/ - -static void writeLn (void) -{ - char ch; - int i; - - ch = ASCII_lf; - i = static_cast (libc_write (1, &ch, static_cast (1))); -} - - -/* - AssignDebug - assigns, file, and, line, information to string, s. -*/ - -static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high) -{ - void * f; - void * p; - char file[_file_high+1]; - char proc[_proc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - memcpy (proc, proc_, _proc_high+1); - - f = &file; - p = &proc; - Storage_ALLOCATE (&s->debug.file, (StrLib_StrLen ((const char *) file, _file_high))+1); - if ((libc_strncpy (s->debug.file, f, (StrLib_StrLen ((const char *) file, _file_high))+1)) == NULL) - {} /* empty. */ - s->debug.line = line; - Storage_ALLOCATE (&s->debug.proc, (StrLib_StrLen ((const char *) proc, _proc_high))+1); - if ((libc_strncpy (s->debug.proc, p, (StrLib_StrLen ((const char *) proc, _proc_high))+1)) == NULL) - {} /* empty. */ - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsOn - returns TRUE if, s, is on one of the debug lists. -*/ - -static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s) -{ - while ((list != s) && (list != NULL)) - { - list = list->debug.next; - } - return list == s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - AddTo - adds string, s, to, list. -*/ - -static void AddTo (DynamicStrings_String *list, DynamicStrings_String s) -{ - if ((*list) == NULL) - { - (*list) = s; - s->debug.next = NULL; - } - else - { - s->debug.next = (*list); - (*list) = s; - } -} - - -/* - SubFrom - removes string, s, from, list. -*/ - -static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s) -{ - DynamicStrings_String p; - - if ((*list) == s) - { - (*list) = s->debug.next; - } - else - { - p = (*list); - while ((p->debug.next != NULL) && (p->debug.next != s)) - { - p = p->debug.next; - } - if (p->debug.next == s) - { - p->debug.next = s->debug.next; - } - else - { - /* not found, quit */ - return ; - } - } - s->debug.next = NULL; -} - - -/* - AddAllocated - adds string, s, to the head of the allocated list. -*/ - -static void AddAllocated (DynamicStrings_String s) -{ - Init (); - AddTo (&frameHead->alloc, s); -} - - -/* - AddDeallocated - adds string, s, to the head of the deallocated list. -*/ - -static void AddDeallocated (DynamicStrings_String s) -{ - Init (); - AddTo (&frameHead->dealloc, s); -} - - -/* - IsOnAllocated - returns TRUE if the string, s, has ever been allocated. -*/ - -static unsigned int IsOnAllocated (DynamicStrings_String s) -{ - DynamicStrings_frame f; - - Init (); - f = frameHead; - do { - if (IsOn (f->alloc, s)) - { - return TRUE; - } - else - { - f = f->next; - } - } while (! (f == NULL)); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated. -*/ - -static unsigned int IsOnDeallocated (DynamicStrings_String s) -{ - DynamicStrings_frame f; - - Init (); - f = frameHead; - do { - if (IsOn (f->dealloc, s)) - { - return TRUE; - } - else - { - f = f->next; - } - } while (! (f == NULL)); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SubAllocated - removes string, s, from the list of allocated strings. -*/ - -static void SubAllocated (DynamicStrings_String s) -{ - DynamicStrings_frame f; - - Init (); - f = frameHead; - do { - if (IsOn (f->alloc, s)) - { - SubFrom (&f->alloc, s); - return ; - } - else - { - f = f->next; - } - } while (! (f == NULL)); -} - - -/* - SubDeallocated - removes string, s, from the list of deallocated strings. -*/ - -static void SubDeallocated (DynamicStrings_String s) -{ - DynamicStrings_frame f; - - Init (); - f = frameHead; - do { - if (IsOn (f->dealloc, s)) - { - SubFrom (&f->dealloc, s); - return ; - } - else - { - f = f->next; - } - } while (! (f == NULL)); -} - - -/* - SubDebugInfo - removes string, s, from the list of allocated strings. -*/ - -static void SubDebugInfo (DynamicStrings_String s) -{ - if (IsOnDeallocated (s)) - { - Assertion_Assert (! DebugOn); - /* string has already been deallocated */ - return ; - } - if (IsOnAllocated (s)) - { - SubAllocated (s); - AddDeallocated (s); - } - else - { - /* string has not been allocated */ - Assertion_Assert (! DebugOn); - } -} - - -/* - AddDebugInfo - adds string, s, to the list of allocated strings. -*/ - -static void AddDebugInfo (DynamicStrings_String s) -{ - s->debug.next = NULL; - s->debug.file = NULL; - s->debug.line = 0; - s->debug.proc = NULL; - if (CheckOn) - { - AddAllocated (s); - } -} - - -/* - ConcatContents - add the contents of string, a, where, h, is the - total length of, a. The offset is in, o. -*/ - -static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o) -{ - unsigned int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = (*c).len; - while ((o < h) && (i < MaxBuf)) - { - (*c).buf.array[i] = a[o]; - o += 1; - i += 1; - } - if (o < h) - { - (*c).len = MaxBuf; - Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord)); - (*c).next->head = NULL; - (*c).next->contents.len = 0; - (*c).next->contents.next = NULL; - ConcatContents (&(*c).next->contents, (const char *) a, _a_high, h, o); - AddDebugInfo ((*c).next); - (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14); - } - else - { - (*c).len = i; - } -} - - -/* - DeallocateCharStar - deallocates any charStar. -*/ - -static void DeallocateCharStar (DynamicStrings_String s) -{ - if ((s != NULL) && (s->head != NULL)) - { - if (s->head->charStarUsed && (s->head->charStar != NULL)) - { - Storage_DEALLOCATE (&s->head->charStar, s->head->charStarSize); - } - s->head->charStarUsed = FALSE; - s->head->charStar = NULL; - s->head->charStarSize = 0; - s->head->charStarValid = FALSE; - } -} - - -/* - CheckPoisoned - checks for a poisoned string, s. -*/ - -static DynamicStrings_String CheckPoisoned (DynamicStrings_String s) -{ - if (((PoisonOn && (s != NULL)) && (s->head != NULL)) && (s->head->state == DynamicStrings_poisoned)) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - MarkInvalid - marks the char * version of String, s, as invalid. -*/ - -static void MarkInvalid (DynamicStrings_String s) -{ - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (s->head != NULL) - { - s->head->charStarValid = FALSE; - } -} - - -/* - ConcatContentsAddress - concatenate the string, a, where, h, is the - total length of, a. -*/ - -static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h) -{ - typedef char *ConcatContentsAddress__T1; - - ConcatContentsAddress__T1 p; - unsigned int i; - unsigned int j; - - j = 0; - i = (*c).len; - p = static_cast (a); - while ((j < h) && (i < MaxBuf)) - { - (*c).buf.array[i] = (*p); - i += 1; - j += 1; - p += 1; - } - if (j < h) - { - /* avoid dangling else. */ - (*c).len = MaxBuf; - Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord)); - (*c).next->head = NULL; - (*c).next->contents.len = 0; - (*c).next->contents.next = NULL; - ConcatContentsAddress (&(*c).next->contents, reinterpret_cast (p), h-j); - AddDebugInfo ((*c).next); - if (TraceOn) - { - (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21); - } - } - else - { - (*c).len = i; - (*c).next = NULL; - } -} - - -/* - AddToGarbage - adds String, b, onto the garbage list of, a. Providing - the state of b is marked. The state is then altered to - onlist. String, a, is returned. -*/ - -static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b) -{ - DynamicStrings_String c; - - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - /* - IF (a#NIL) AND (a#b) AND (a^.head^.state=marked) - THEN - writeString('warning trying to add to a marked string') ; writeLn - END ; - */ - if (((((a != b) && (a != NULL)) && (b != NULL)) && (b->head->state == DynamicStrings_marked)) && (a->head->state == DynamicStrings_inuse)) - { - c = a; - while (c->head->garbage != NULL) - { - c = c->head->garbage; - } - c->head->garbage = b; - b->head->state = DynamicStrings_onlist; - if (CheckOn) - { - SubDebugInfo (b); - } - } - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsOnGarbage - returns TRUE if, s, is on string, e, garbage list. -*/ - -static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s) -{ - if ((e != NULL) && (s != NULL)) - { - while (e->head->garbage != NULL) - { - if (e->head->garbage == s) - { - return TRUE; - } - else - { - e = e->head->garbage; - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch) -{ - return (ch == ' ') || (ch == ASCII_tab); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DumpState - -*/ - -static void DumpState (DynamicStrings_String s) -{ - switch (s->head->state) - { - case DynamicStrings_inuse: - writeString ((const char *) "still in use (", 14); - writeCard (s->contents.len); - writeString ((const char *) ") characters", 12); - break; - - case DynamicStrings_marked: - writeString ((const char *) "marked", 6); - break; - - case DynamicStrings_onlist: - writeString ((const char *) "on a garbage list", 17); - break; - - case DynamicStrings_poisoned: - writeString ((const char *) "poisoned", 8); - break; - - - default: - writeString ((const char *) "unknown state", 13); - break; - } -} - - -/* - DumpStringSynopsis - -*/ - -static void DumpStringSynopsis (DynamicStrings_String s) -{ - writeCstring (s->debug.file); - writeString ((const char *) ":", 1); - writeCard (s->debug.line); - writeString ((const char *) ":", 1); - writeCstring (s->debug.proc); - writeString ((const char *) " string ", 8); - writeAddress (reinterpret_cast (s)); - writeString ((const char *) " ", 1); - DumpState (s); - if (IsOnAllocated (s)) - { - writeString ((const char *) " globally allocated", 19); - } - else if (IsOnDeallocated (s)) - { - /* avoid dangling else. */ - writeString ((const char *) " globally deallocated", 21); - } - else - { - /* avoid dangling else. */ - writeString ((const char *) " globally unknown", 17); - } - writeLn (); -} - - -/* - DumpString - displays the contents of string, s. -*/ - -static void DumpString (DynamicStrings_String s) -{ - DynamicStrings_String t; - - if (s != NULL) - { - DumpStringSynopsis (s); - if ((s->head != NULL) && (s->head->garbage != NULL)) - { - writeString ((const char *) "display chained strings on the garbage list", 43); - writeLn (); - t = s->head->garbage; - while (t != NULL) - { - DumpStringSynopsis (t); - t = t->head->garbage; - } - } - } -} - - -/* - Init - initialize the module. -*/ - -static void Init (void) -{ - if (! Initialized) - { - Initialized = TRUE; - frameHead = NULL; - DynamicStrings_PushAllocation (); - } -} - - -/* - InitString - creates and returns a String type object. - Initial contents are, a. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high) -{ - DynamicStrings_String s; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord)); - s->contents.len = 0; - s->contents.next = NULL; - ConcatContents (&s->contents, (const char *) a, _a_high, StrLib_StrLen ((const char *) a, _a_high), 0); - Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor)); - s->head->charStarUsed = FALSE; - s->head->charStar = NULL; - s->head->charStarSize = 0; - s->head->charStarValid = FALSE; - s->head->garbage = NULL; - s->head->state = DynamicStrings_inuse; - AddDebugInfo (s); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillString - frees String, s, and its contents. - NIL is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s) -{ - DynamicStrings_String t; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (s != NULL) - { - if (CheckOn) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (IsOnAllocated (s)) - { - SubAllocated (s); - } - else if (IsOnDeallocated (s)) - { - /* avoid dangling else. */ - SubDeallocated (s); - } - } - if (s->head != NULL) - { - s->head->state = DynamicStrings_poisoned; - s->head->garbage = DynamicStrings_KillString (s->head->garbage); - if (! PoisonOn) - { - DeallocateCharStar (s); - } - if (! PoisonOn) - { - Storage_DEALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor)); - s->head = NULL; - } - } - t = DynamicStrings_KillString (s->contents.next); - if (! PoisonOn) - { - Storage_DEALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord)); - } - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Fin - finishes with a string, it calls KillString with, s. - The purpose of the procedure is to provide a short cut - to calling KillString and then testing the return result. -*/ - -extern "C" void DynamicStrings_Fin (DynamicStrings_String s) -{ - if ((DynamicStrings_KillString (s)) != NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - InitStringCharStar - initializes and returns a String to contain the C string. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a) -{ - DynamicStrings_String s; - - Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord)); - s->contents.len = 0; - s->contents.next = NULL; - if (a != NULL) - { - ConcatContentsAddress (&s->contents, a, static_cast (libc_strlen (a))); - } - Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor)); - s->head->charStarUsed = FALSE; - s->head->charStar = NULL; - s->head->charStarSize = 0; - s->head->charStarValid = FALSE; - s->head->garbage = NULL; - s->head->state = DynamicStrings_inuse; - AddDebugInfo (s); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitStringChar - initializes and returns a String to contain the single character, ch. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch) -{ - typedef struct InitStringChar__T4_a InitStringChar__T4; - - struct InitStringChar__T4_a { char array[1+1]; }; - InitStringChar__T4 a; - DynamicStrings_String s; - - a.array[0] = ch; - a.array[1] = ASCII_nul; - s = DynamicStrings_InitString ((const char *) &a.array[0], 1); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Mark - marks String, s, ready for garbage collection. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s) -{ - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if ((s != NULL) && (s->head->state == DynamicStrings_inuse)) - { - s->head->state = DynamicStrings_marked; - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Length - returns the length of the String, s. -*/ - -extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s) -{ - if (s == NULL) - { - return 0; - } - else - { - return s->contents.len+(DynamicStrings_Length (s->contents.next)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConCat - returns String, a, after the contents of, b, have been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b) -{ - DynamicStrings_String t; - - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - if (a == b) - { - return DynamicStrings_ConCat (a, DynamicStrings_Mark (DynamicStrings_Dup (b))); - } - else if (a != NULL) - { - /* avoid dangling else. */ - a = AddToGarbage (a, b); - MarkInvalid (a); - t = a; - while (b != NULL) - { - while ((t->contents.len == MaxBuf) && (t->contents.next != NULL)) - { - t = t->contents.next; - } - ConcatContents (&t->contents, (const char *) &b->contents.buf.array[0], (MaxBuf-1), b->contents.len, 0); - b = b->contents.next; - } - } - if ((a == NULL) && (b != NULL)) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConCatChar - returns String, a, after character, ch, has been appended. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch) -{ - typedef struct ConCatChar__T5_a ConCatChar__T5; - - struct ConCatChar__T5_a { char array[1+1]; }; - ConCatChar__T5 b; - DynamicStrings_String t; - - if (PoisonOn) - { - a = CheckPoisoned (a); - } - b.array[0] = ch; - b.array[1] = ASCII_nul; - t = a; - MarkInvalid (a); - while ((t->contents.len == MaxBuf) && (t->contents.next != NULL)) - { - t = t->contents.next; - } - ConcatContents (&t->contents, (const char *) &b.array[0], 1, 1, 0); - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Assign - assigns the contents of, b, into, a. - String, a, is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b) -{ - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - if ((a != NULL) && (b != NULL)) - { - a->contents.next = DynamicStrings_KillString (a->contents.next); - a->contents.len = 0; - } - return DynamicStrings_ConCat (a, b); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Dup - duplicate a String, s, returning the copy of s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s) -{ - if (PoisonOn) - { - s = CheckPoisoned (s); - } - s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Add - returns a new String which contains the contents of a and b. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b) -{ - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b); - if (TraceOn) - { - a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3); - } - return a; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Equal - returns TRUE if String, a, and, b, are equal. -*/ - -extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b) -{ - unsigned int i; - - if (PoisonOn) - { - a = CheckPoisoned (a); - b = CheckPoisoned (b); - } - if ((DynamicStrings_Length (a)) == (DynamicStrings_Length (b))) - { - while ((a != NULL) && (b != NULL)) - { - i = 0; - Assertion_Assert (a->contents.len == b->contents.len); - while (i < a->contents.len) - { - if (a->contents.buf.array[i] != b->contents.buf.array[i]) - { - return FALSE; - } - i += 1; - } - a = a->contents.next; - b = b->contents.next; - } - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EqualCharStar - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a) -{ - DynamicStrings_String t; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - t = DynamicStrings_InitStringCharStar (a); - if (TraceOn) - { - t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13); - } - t = AddToGarbage (t, s); - if (DynamicStrings_Equal (t, s)) - { - t = DynamicStrings_KillString (t); - return TRUE; - } - else - { - t = DynamicStrings_KillString (t); - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EqualArray - returns TRUE if contents of String, s, is the same as the - string, a. -*/ - -extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high) -{ - DynamicStrings_String t; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - t = DynamicStrings_InitString ((const char *) a, _a_high); - if (TraceOn) - { - t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10); - } - t = AddToGarbage (t, s); - if (DynamicStrings_Equal (t, s)) - { - t = DynamicStrings_KillString (t); - return TRUE; - } - else - { - t = DynamicStrings_KillString (t); - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Mult - returns a new string which is n concatenations of String, s. -*/ - -extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n) -{ - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (n <= 0) - { - s = AddToGarbage (DynamicStrings_InitString ((const char *) "", 0), s); - } - else - { - s = DynamicStrings_ConCat (DynamicStrings_Mult (s, n-1), s); - } - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Slice - returns a new string which contains the elements - low..high-1 - - strings start at element 0 - Slice(s, 0, 2) will return elements 0, 1 but not 2 - Slice(s, 1, 3) will return elements 1, 2 but not 3 - Slice(s, 2, 0) will return elements 2..max - Slice(s, 3, -1) will return elements 3..max-1 - Slice(s, 4, -2) will return elements 4..max-2 -*/ - -extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high) -{ - DynamicStrings_String d; - DynamicStrings_String t; - int start; - int end; - int o; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (low < 0) - { - low = ((int ) (DynamicStrings_Length (s)))+low; - } - if (high <= 0) - { - high = ((int ) (DynamicStrings_Length (s)))+high; - } - else - { - /* make sure high is <= Length (s) */ - high = Min (DynamicStrings_Length (s), static_cast (high)); - } - d = DynamicStrings_InitString ((const char *) "", 0); - d = AddToGarbage (d, s); - o = 0; - t = d; - while (s != NULL) - { - if (low < (o+((int ) (s->contents.len)))) - { - if (o > high) - { - s = NULL; - } - else - { - /* found sliceable unit */ - if (low < o) - { - start = 0; - } - else - { - start = low-o; - } - end = Max (Min (MaxBuf, static_cast (high-o)), 0); - while (t->contents.len == MaxBuf) - { - if (t->contents.next == NULL) - { - Storage_ALLOCATE ((void **) &t->contents.next, sizeof (DynamicStrings_stringRecord)); - t->contents.next->head = NULL; - t->contents.next->contents.len = 0; - AddDebugInfo (t->contents.next); - if (TraceOn) - { - t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5); - } - } - t = t->contents.next; - } - ConcatContentsAddress (&t->contents, &s->contents.buf.array[start], static_cast (end-start)); - o += s->contents.len; - s = s->contents.next; - } - } - else - { - o += s->contents.len; - s = s->contents.next; - } - } - if (TraceOn) - { - d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5); - } - return d; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Index - returns the indice of the first occurance of, ch, in - String, s. -1 is returned if, ch, does not exist. - The search starts at position, o. -*/ - -extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o) -{ - unsigned int i; - unsigned int k; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - k = 0; - while (s != NULL) - { - if ((k+s->contents.len) < o) - { - k += s->contents.len; - } - else - { - i = o-k; - while (i < s->contents.len) - { - if (s->contents.buf.array[i] == ch) - { - return k+i; - } - i += 1; - } - k += i; - o = k; - } - s = s->contents.next; - } - return -1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RIndex - returns the indice of the last occurance of, ch, - in String, s. The search starts at position, o. - -1 is returned if, ch, is not found. -*/ - -extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o) -{ - unsigned int i; - unsigned int k; - int j; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - j = -1; - k = 0; - while (s != NULL) - { - if ((k+s->contents.len) < o) - { - k += s->contents.len; - } - else - { - if (o < k) - { - i = 0; - } - else - { - i = o-k; - } - while (i < s->contents.len) - { - if (s->contents.buf.array[i] == ch) - { - j = k; - } - k += 1; - i += 1; - } - } - s = s->contents.next; - } - return j; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveComment - assuming that, comment, is a comment delimiter - which indicates anything to its right is a comment - then strip off the comment and also any white space - on the remaining right hand side. - It leaves any white space on the left hand side alone. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment) -{ - int i; - - i = DynamicStrings_Index (s, comment, 0); - if (i == 0) - { - s = DynamicStrings_InitString ((const char *) "", 0); - } - else if (i > 0) - { - /* avoid dangling else. */ - s = DynamicStrings_RemoveWhitePostfix (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i)); - } - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveWhitePrefix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s) -{ - unsigned int i; - - i = 0; - while (IsWhite (DynamicStrings_char (s, static_cast (i)))) - { - i += 1; - } - s = DynamicStrings_Slice (s, (int ) (i), 0); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveWhitePostfix - removes any leading white space from String, s. - A new string is returned. -*/ - -extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s) -{ - int i; - - i = ((int ) (DynamicStrings_Length (s)))-1; - while ((i >= 0) && (IsWhite (DynamicStrings_char (s, i)))) - { - i -= 1; - } - s = DynamicStrings_Slice (s, 0, i+1); - if (TraceOn) - { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ToUpper - returns string, s, after it has had its lower case characters - replaced by upper case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s) -{ - char ch; - unsigned int i; - DynamicStrings_String t; - - if (s != NULL) - { - MarkInvalid (s); - t = s; - while (t != NULL) - { - i = 0; - while (i < t->contents.len) - { - ch = t->contents.buf.array[i]; - if ((ch >= 'a') && (ch <= 'z')) - { - t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A')))); - } - i += 1; - } - t = t->contents.next; - } - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ToLower - returns string, s, after it has had its upper case characters - replaced by lower case characters. - The string, s, is not duplicated. -*/ - -extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s) -{ - char ch; - unsigned int i; - DynamicStrings_String t; - - if (s != NULL) - { - MarkInvalid (s); - t = s; - while (t != NULL) - { - i = 0; - while (i < t->contents.len) - { - ch = t->contents.buf.array[i]; - if ((ch >= 'A') && (ch <= 'Z')) - { - t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a')))); - } - i += 1; - } - t = t->contents.next; - } - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CopyOut - copies string, s, to a. -*/ - -extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s) -{ - unsigned int i; - unsigned int l; - - l = Min (_a_high+1, DynamicStrings_Length (s)); - i = 0; - while (i < l) - { - a[i] = DynamicStrings_char (s, static_cast (i)); - i += 1; - } - if (i <= _a_high) - { - a[i] = ASCII_nul; - } -} - - -/* - char - returns the character, ch, at position, i, in String, s. -*/ - -extern "C" char DynamicStrings_char (DynamicStrings_String s, int i) -{ - unsigned int c; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (i < 0) - { - c = (unsigned int ) (((int ) (DynamicStrings_Length (s)))+i); - } - else - { - c = i; - } - while ((s != NULL) && (c >= s->contents.len)) - { - c -= s->contents.len; - s = s->contents.next; - } - if ((s == NULL) || (c >= s->contents.len)) - { - return ASCII_nul; - } - else - { - return s->contents.buf.array[c]; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - string - returns the C style char * of String, s. -*/ - -extern "C" void * DynamicStrings_string (DynamicStrings_String s) -{ - typedef char *string__T2; - - DynamicStrings_String a; - unsigned int l; - unsigned int i; - string__T2 p; - - if (PoisonOn) - { - s = CheckPoisoned (s); - } - if (s == NULL) - { - return NULL; - } - else - { - if (! s->head->charStarValid) - { - l = DynamicStrings_Length (s); - if (! (s->head->charStarUsed && (s->head->charStarSize > l))) - { - DeallocateCharStar (s); - Storage_ALLOCATE (&s->head->charStar, l+1); - s->head->charStarSize = l+1; - s->head->charStarUsed = TRUE; - } - p = static_cast (s->head->charStar); - a = s; - while (a != NULL) - { - i = 0; - while (i < a->contents.len) - { - (*p) = a->contents.buf.array[i]; - i += 1; - p += 1; - } - a = a->contents.next; - } - (*p) = ASCII_nul; - s->head->charStarValid = TRUE; - } - return s->head->charStar; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitStringDB - the debug version of InitString. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line) -{ - char a[_a_high+1]; - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_InitString ((const char *) a, _a_high), (const char *) file, _file_high, line, (const char *) "InitString", 10); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitStringCharStarDB - the debug version of InitStringCharStar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_InitStringCharStar (a), (const char *) file, _file_high, line, (const char *) "InitStringCharStar", 18); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitStringCharDB - the debug version of InitStringChar. -*/ - -extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_InitStringChar (ch), (const char *) file, _file_high, line, (const char *) "InitStringChar", 14); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - MultDB - the debug version of MultDB. -*/ - -extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_Mult (s, n), (const char *) file, _file_high, line, (const char *) "Mult", 4); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DupDB - the debug version of Dup. -*/ - -extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - return AssignDebug (DynamicStrings_Dup (s), (const char *) file, _file_high, line, (const char *) "Dup", 3); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SliceDB - debug version of Slice. -*/ - -extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line) -{ - char file[_file_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (file, file_, _file_high+1); - - DSdbEnter (); - s = AssignDebug (DynamicStrings_Slice (s, low, high), (const char *) file, _file_high, line, (const char *) "Slice", 5); - DSdbExit (s); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PushAllocation - pushes the current allocation/deallocation lists. -*/ - -extern "C" void DynamicStrings_PushAllocation (void) -{ - DynamicStrings_frame f; - - if (CheckOn) - { - Init (); - Storage_ALLOCATE ((void **) &f, sizeof (DynamicStrings_frameRec)); - f->next = frameHead; - f->alloc = NULL; - f->dealloc = NULL; - frameHead = f; - } -} - - -/* - PopAllocation - test to see that all strings are deallocated since - the last push. Then it pops to the previous - allocation/deallocation lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" void DynamicStrings_PopAllocation (unsigned int halt) -{ - if (CheckOn) - { - if ((DynamicStrings_PopAllocationExemption (halt, NULL)) == NULL) - {} /* empty. */ - } -} - - -/* - PopAllocationExemption - test to see that all strings are deallocated, except - string, e, since the last push. - Then it pops to the previous allocation/deallocation - lists. - - If halt is true then the application terminates - with an exit code of 1. -*/ - -extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e) -{ - DynamicStrings_String s; - DynamicStrings_frame f; - unsigned int b; - - Init (); - if (CheckOn) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (frameHead == NULL) - { - stop (); - /* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") */ - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65); - } - else - { - if (frameHead->alloc != NULL) - { - b = FALSE; - s = frameHead->alloc; - while (s != NULL) - { - if (! (((e == s) || (IsOnGarbage (e, s))) || (IsOnGarbage (s, e)))) - { - if (! b) - { - writeString ((const char *) "the following strings have been lost", 36); - writeLn (); - b = TRUE; - } - DumpStringInfo (s, 0); - } - s = s->debug.next; - } - if (b && halt) - { - libc_exit (1); - } - } - frameHead = frameHead->next; - } - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_DynamicStrings_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Initialized = FALSE; - Init (); -} - -extern "C" void _M2_DynamicStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GFIO.c b/gcc/m2/pge-boot/GFIO.c deleted file mode 100644 index 848860781aae..000000000000 --- a/gcc/m2/pge-boot/GFIO.c +++ /dev/null @@ -1,2325 +0,0 @@ -/* do not edit automatically generated by mc from FIO. */ -/* FIO.mod provides a simple buffered file input/output library. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -#include -# include "GStorage.h" -# include "Gmcrts.h" -#include -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _FIO_H -#define _FIO_C - -# include "GSYSTEM.h" -# include "GASCII.h" -# include "GStrLib.h" -# include "GStorage.h" -# include "GNumberIO.h" -# include "Glibc.h" -# include "GIndexing.h" -# include "GM2RTS.h" - -typedef unsigned int FIO_File; - -FIO_File FIO_StdErr; -FIO_File FIO_StdOut; -FIO_File FIO_StdIn; -# define SEEK_SET 0 -# define SEEK_END 2 -# define UNIXREADONLY 0 -# define UNIXWRITEONLY 1 -# define CreatePermissions 0666 -# define MaxBufferLength (1024*16) -# define MaxErrorString (1024*8) -typedef struct FIO_NameInfo_r FIO_NameInfo; - -typedef struct FIO_buf_r FIO_buf; - -typedef FIO_buf *FIO_Buffer; - -typedef struct FIO_fds_r FIO_fds; - -typedef FIO_fds *FIO_FileDescriptor; - -typedef struct FIO__T7_a FIO__T7; - -typedef char *FIO_PtrToChar; - -typedef enum {FIO_successful, FIO_outofmemory, FIO_toomanyfilesopen, FIO_failed, FIO_connectionfailure, FIO_endofline, FIO_endoffile} FIO_FileStatus; - -typedef enum {FIO_unused, FIO_openedforread, FIO_openedforwrite, FIO_openedforrandom} FIO_FileUsage; - -struct FIO_NameInfo_r { - void *address; - unsigned int size; - }; - -struct FIO_buf_r { - unsigned int valid; - long int bufstart; - unsigned int position; - void *address; - unsigned int filled; - unsigned int size; - unsigned int left; - FIO__T7 *contents; - }; - -struct FIO__T7_a { char array[MaxBufferLength+1]; }; -struct FIO_fds_r { - int unixfd; - FIO_NameInfo name; - FIO_FileStatus state; - FIO_FileUsage usage; - unsigned int output; - FIO_Buffer buffer; - long int abspos; - }; - -static Indexing_Index FileInfo; -static FIO_File Error; - -/* - IsNoError - returns a TRUE if no error has occured on file, f. -*/ - -extern "C" unsigned int FIO_IsNoError (FIO_File f); - -/* - IsActive - returns TRUE if the file, f, is still active. -*/ - -extern "C" unsigned int FIO_IsActive (FIO_File f); -extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high); -extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile); - -/* - Close - close a file which has been previously opened using: - OpenToRead, OpenToWrite, OpenForRandom. - It is correct to close a file which has an error status. -*/ - -extern "C" void FIO_Close (FIO_File f); - -/* - exists - returns TRUE if a file named, fname exists for reading. -*/ - -extern "C" unsigned int FIO_exists (void * fname, unsigned int flength); - -/* - openToRead - attempts to open a file, fname, for reading and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength); - -/* - openToWrite - attempts to open a file, fname, for write and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength); - -/* - openForRandom - attempts to open a file, fname, for random access - read or write and it returns this file. - The success of this operation can be checked by - calling IsNoError. - towrite, determines whether the file should be - opened for writing or reading. -*/ - -extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile); - -/* - FlushBuffer - flush contents of file, f. -*/ - -extern "C" void FIO_FlushBuffer (FIO_File f); - -/* - ReadNBytes - reads nBytes of a file into memory area, dest, returning - the number of bytes actually read. - This function will consume from the buffer and then - perform direct libc reads. It is ideal for large reads. -*/ - -extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest); - -/* - ReadAny - reads HIGH(a) bytes into, a. All input - is fully buffered, unlike ReadNBytes and thus is more - suited to small reads. -*/ - -extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high); - -/* - WriteNBytes - writes nBytes from memory area src to a file - returning the number of bytes actually written. - This function will flush the buffer and then - write the nBytes using a direct write from libc. - It is ideal for large writes. -*/ - -extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src); - -/* - WriteAny - writes HIGH(a) bytes onto, file, f. All output - is fully buffered, unlike WriteNBytes and thus is more - suited to small writes. -*/ - -extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high); - -/* - WriteChar - writes a single character to file, f. -*/ - -extern "C" void FIO_WriteChar (FIO_File f, char ch); - -/* - EOF - tests to see whether a file, f, has reached end of file. -*/ - -extern "C" unsigned int FIO_EOF (FIO_File f); - -/* - EOLN - tests to see whether a file, f, is upon a newline. - It does NOT consume the newline. -*/ - -extern "C" unsigned int FIO_EOLN (FIO_File f); - -/* - WasEOLN - tests to see whether a file, f, has just seen a newline. -*/ - -extern "C" unsigned int FIO_WasEOLN (FIO_File f); - -/* - ReadChar - returns a character read from file f. - Sensible to check with IsNoError or EOF after calling - this function. -*/ - -extern "C" char FIO_ReadChar (FIO_File f); - -/* - UnReadChar - replaces a character, ch, back into file f. - This character must have been read by ReadChar - and it does not allow successive calls. It may - only be called if the previous read was successful - or end of file was seen. - If the state was previously endoffile then it - is altered to successful. - Otherwise it is left alone. -*/ - -extern "C" void FIO_UnReadChar (FIO_File f, char ch); - -/* - WriteLine - writes out a linefeed to file, f. -*/ - -extern "C" void FIO_WriteLine (FIO_File f); - -/* - WriteString - writes a string to file, f. -*/ - -extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high); - -/* - ReadString - reads a string from file, f, into string, a. - It terminates the string if HIGH is reached or - if a newline is seen or an error occurs. -*/ - -extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high); - -/* - WriteCardinal - writes a CARDINAL to file, f. - It writes the binary image of the cardinal - to file, f. -*/ - -extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c); - -/* - ReadCardinal - reads a CARDINAL from file, f. - It reads a binary image of a CARDINAL - from a file, f. -*/ - -extern "C" unsigned int FIO_ReadCardinal (FIO_File f); - -/* - GetUnixFileDescriptor - returns the UNIX file descriptor of a file. -*/ - -extern "C" int FIO_GetUnixFileDescriptor (FIO_File f); - -/* - SetPositionFromBeginning - sets the position from the beginning of the file. -*/ - -extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos); - -/* - SetPositionFromEnd - sets the position from the end of the file. -*/ - -extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos); - -/* - FindPosition - returns the current absolute position in file, f. -*/ - -extern "C" long int FIO_FindPosition (FIO_File f); - -/* - GetFileName - assigns, a, with the filename associated with, f. -*/ - -extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high); - -/* - getFileName - returns the address of the filename associated with, f. -*/ - -extern "C" void * FIO_getFileName (FIO_File f); - -/* - getFileNameLength - returns the number of characters associated with filename, f. -*/ - -extern "C" unsigned int FIO_getFileNameLength (FIO_File f); - -/* - FlushOutErr - flushes, StdOut, and, StdErr. - It is also called when the application calls M2RTS.Terminate. - (which is automatically placed in program modules by the GM2 - scaffold). -*/ - -extern "C" void FIO_FlushOutErr (void); - -/* - Max - returns the maximum of two values. -*/ - -static unsigned int Max (unsigned int a, unsigned int b); - -/* - Min - returns the minimum of two values. -*/ - -static unsigned int Min (unsigned int a, unsigned int b); - -/* - GetNextFreeDescriptor - returns the index to the FileInfo array indicating - the next free slot. -*/ - -static FIO_File GetNextFreeDescriptor (void); - -/* - SetState - sets the field, state, of file, f, to, s. -*/ - -static void SetState (FIO_File f, FIO_FileStatus s); - -/* - InitializeFile - initialize a file descriptor -*/ - -static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength); - -/* - ConnectToUnix - connects a FIO file to a UNIX file descriptor. -*/ - -static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile); - -/* - ReadFromBuffer - attempts to read, nBytes, from file, f. - It firstly consumes the buffer and then performs - direct unbuffered reads. This should only be used - when wishing to read large files. - - The actual number of bytes read is returned. - -1 is returned if EOF is reached. -*/ - -static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes); - -/* - BufferedRead - will read, nBytes, through the buffer. - Similar to ReadFromBuffer, but this function will always - read into the buffer before copying into memory. - - Useful when performing small reads. -*/ - -static int BufferedRead (FIO_File f, unsigned int nBytes, void * a); - -/* - HandleEscape - translates - and \t into their respective ascii codes. -*/ - -static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest); - -/* - Cast - casts a := b -*/ - -static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high); - -/* - StringFormat1 - converts string, src, into, dest, together with encapsulated - entity, w. It only formats the first %s or %d with n. -*/ - -static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high); - -/* - FormatError - provides a orthoganal counterpart to the procedure below. -*/ - -static void FormatError (const char *a_, unsigned int _a_high); - -/* - FormatError1 - generic error procedure taking standard format string - and single parameter. -*/ - -static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high); - -/* - FormatError2 - generic error procedure taking standard format string - and two parameters. -*/ - -static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); - -/* - CheckAccess - checks to see whether a file f has been - opened for read/write. -*/ - -static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite); - -/* - SetEndOfLine - -*/ - -static void SetEndOfLine (FIO_File f, char ch); - -/* - BufferedWrite - will write, nBytes, through the buffer. - Similar to WriteNBytes, but this function will always - write into the buffer before copying into memory. - - Useful when performing small writes. -*/ - -static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a); - -/* - PreInitialize - preinitialize the file descriptor. -*/ - -static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize); - -/* - Init - initialize the modules, global variables. -*/ - -static void Init (void); - - -/* - Max - returns the maximum of two values. -*/ - -static unsigned int Max (unsigned int a, unsigned int b) -{ - if (a > b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Min - returns the minimum of two values. -*/ - -static unsigned int Min (unsigned int a, unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetNextFreeDescriptor - returns the index to the FileInfo array indicating - the next free slot. -*/ - -static FIO_File GetNextFreeDescriptor (void) -{ - FIO_File f; - FIO_File h; - FIO_FileDescriptor fd; - - f = Error+1; - h = Indexing_HighIndice (FileInfo); - for (;;) - { - if (f <= h) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - return f; - } - } - f += 1; - if (f > h) - { - Indexing_PutIndice (FileInfo, f, NULL); /* create new slot */ - return f; /* create new slot */ - } - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1); - __builtin_unreachable (); -} - - -/* - SetState - sets the field, state, of file, f, to, s. -*/ - -static void SetState (FIO_File f, FIO_FileStatus s) -{ - FIO_FileDescriptor fd; - - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - fd->state = s; -} - - -/* - InitializeFile - initialize a file descriptor -*/ - -static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength) -{ - FIO_PtrToChar p; - FIO_FileDescriptor fd; - - Storage_ALLOCATE ((void **) &fd, sizeof (FIO_fds)); - if (fd == NULL) - { - SetState (Error, FIO_outofmemory); - return Error; - } - else - { - Indexing_PutIndice (FileInfo, f, reinterpret_cast (fd)); - fd->name.size = flength+1; /* need to guarantee the nul for C */ - fd->usage = use; /* need to guarantee the nul for C */ - fd->output = towrite; - Storage_ALLOCATE (&fd->name.address, fd->name.size); - if (fd->name.address == NULL) - { - fd->state = FIO_outofmemory; - return f; - } - fd->name.address = libc_strncpy (fd->name.address, fname, flength); - /* and assign nul to the last byte */ - p = static_cast (fd->name.address); - p += flength; - (*p) = ASCII_nul; - fd->abspos = 0; - /* now for the buffer */ - Storage_ALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf)); - if (fd->buffer == NULL) - { - SetState (Error, FIO_outofmemory); - return Error; - } - else - { - fd->buffer->valid = FALSE; - fd->buffer->bufstart = 0; - fd->buffer->size = buflength; - fd->buffer->position = 0; - fd->buffer->filled = 0; - if (fd->buffer->size == 0) - { - fd->buffer->address = NULL; - } - else - { - Storage_ALLOCATE (&fd->buffer->address, fd->buffer->size); - if (fd->buffer->address == NULL) - { - fd->state = FIO_outofmemory; - return f; - } - } - if (towrite) - { - fd->buffer->left = fd->buffer->size; - } - else - { - fd->buffer->left = 0; - } - fd->buffer->contents = reinterpret_cast (fd->buffer->address); /* provides easy access for reading characters */ - fd->state = fstate; /* provides easy access for reading characters */ - } - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConnectToUnix - connects a FIO file to a UNIX file descriptor. -*/ - -static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - if (towrite) - { - if (newfile) - { - fd->unixfd = libc_creat (fd->name.address, CreatePermissions); - } - else - { - fd->unixfd = libc_open (fd->name.address, UNIXWRITEONLY, 0); - } - } - else - { - fd->unixfd = libc_open (fd->name.address, UNIXREADONLY, 0); - } - if (fd->unixfd < 0) - { - fd->state = FIO_connectionfailure; - } - } - } -} - - -/* - ReadFromBuffer - attempts to read, nBytes, from file, f. - It firstly consumes the buffer and then performs - direct unbuffered reads. This should only be used - when wishing to read large files. - - The actual number of bytes read is returned. - -1 is returned if EOF is reached. -*/ - -static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes) -{ - typedef unsigned char *ReadFromBuffer__T1; - - void * t; - int result; - unsigned int total; - unsigned int n; - ReadFromBuffer__T1 p; - FIO_FileDescriptor fd; - - if (f != Error) - { - total = 0; /* how many bytes have we read */ - fd = static_cast (Indexing_GetIndice (FileInfo, f)); /* how many bytes have we read */ - /* extract from the buffer first */ - if ((fd->buffer != NULL) && fd->buffer->valid) - { - if (fd->buffer->left > 0) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (nBytes == 1) - { - /* too expensive to call memcpy for 1 character */ - p = static_cast (a); - (*p) = static_cast ((*fd->buffer->contents).array[fd->buffer->position]); - fd->buffer->left -= 1; /* remove consumed bytes */ - fd->buffer->position += 1; /* move onwards n bytes */ - nBytes = 0; - /* read */ - return 1; - } - else - { - n = Min (fd->buffer->left, nBytes); - t = fd->buffer->address; - t = reinterpret_cast (reinterpret_cast (t)+fd->buffer->position); - p = static_cast (libc_memcpy (a, t, static_cast (n))); - fd->buffer->left -= n; /* remove consumed bytes */ - fd->buffer->position += n; /* move onwards n bytes */ - /* move onwards ready for direct reads */ - a = reinterpret_cast (reinterpret_cast (a)+n); - nBytes -= n; /* reduce the amount for future direct */ - /* read */ - total += n; - return total; /* much cleaner to return now, */ - } - /* difficult to record an error if */ - } - /* the read below returns -1 */ - } - if (nBytes > 0) - { - /* still more to read */ - result = static_cast (libc_read (fd->unixfd, a, static_cast ((int ) (nBytes)))); - if (result > 0) - { - /* avoid dangling else. */ - total += result; - fd->abspos += result; - /* now disable the buffer as we read directly into, a. */ - if (fd->buffer != NULL) - { - fd->buffer->valid = FALSE; - } - } - else - { - if (result == 0) - { - /* eof reached */ - fd->state = FIO_endoffile; - } - else - { - fd->state = FIO_failed; - } - /* indicate buffer is empty */ - if (fd->buffer != NULL) - { - fd->buffer->valid = FALSE; - fd->buffer->left = 0; - fd->buffer->position = 0; - if (fd->buffer->address != NULL) - { - (*fd->buffer->contents).array[fd->buffer->position] = ASCII_nul; - } - } - return -1; - } - } - return total; - } - else - { - return -1; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - BufferedRead - will read, nBytes, through the buffer. - Similar to ReadFromBuffer, but this function will always - read into the buffer before copying into memory. - - Useful when performing small reads. -*/ - -static int BufferedRead (FIO_File f, unsigned int nBytes, void * a) -{ - typedef unsigned char *BufferedRead__T3; - - void * t; - int result; - int total; - int n; - BufferedRead__T3 p; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - total = 0; /* how many bytes have we read */ - if (fd != NULL) /* how many bytes have we read */ - { - /* extract from the buffer first */ - if (fd->buffer != NULL) - { - while (nBytes > 0) - { - if ((fd->buffer->left > 0) && fd->buffer->valid) - { - if (nBytes == 1) - { - /* too expensive to call memcpy for 1 character */ - p = static_cast (a); - (*p) = static_cast ((*fd->buffer->contents).array[fd->buffer->position]); - fd->buffer->left -= 1; /* remove consumed byte */ - fd->buffer->position += 1; /* move onwards n byte */ - total += 1; /* move onwards n byte */ - return total; - } - else - { - n = Min (fd->buffer->left, nBytes); - t = fd->buffer->address; - t = reinterpret_cast (reinterpret_cast (t)+fd->buffer->position); - p = static_cast (libc_memcpy (a, t, static_cast (n))); - fd->buffer->left -= n; /* remove consumed bytes */ - fd->buffer->position += n; /* move onwards n bytes */ - /* move onwards ready for direct reads */ - a = reinterpret_cast (reinterpret_cast (a)+n); - nBytes -= n; /* reduce the amount for future direct */ - /* read */ - total += n; - } - } - else - { - /* refill buffer */ - n = static_cast (libc_read (fd->unixfd, fd->buffer->address, static_cast (fd->buffer->size))); - if (n >= 0) - { - /* avoid dangling else. */ - fd->buffer->valid = TRUE; - fd->buffer->position = 0; - fd->buffer->left = n; - fd->buffer->filled = n; - fd->buffer->bufstart = fd->abspos; - fd->abspos += n; - if (n == 0) - { - /* eof reached */ - fd->state = FIO_endoffile; - return -1; - } - } - else - { - fd->buffer->valid = FALSE; - fd->buffer->position = 0; - fd->buffer->left = 0; - fd->buffer->filled = 0; - fd->state = FIO_failed; - return total; - } - } - } - return total; - } - } - } - return -1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - HandleEscape - translates - and \t into their respective ascii codes. -*/ - -static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest) -{ - char src[_src_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (src, src_, _src_high+1); - - if (((((*i)+1) < HighSrc) && (src[(*i)] == '\\')) && ((*j) < HighDest)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (src[(*i)+1] == 'n') - { - /* requires a newline */ - dest[(*j)] = ASCII_nl; - (*j) += 1; - (*i) += 2; - } - else if (src[(*i)+1] == 't') - { - /* avoid dangling else. */ - /* requires a tab (yuck) tempted to fake this but I better not.. */ - dest[(*j)] = ASCII_tab; - (*j) += 1; - (*i) += 2; - } - else - { - /* avoid dangling else. */ - /* copy escaped character */ - (*i) += 1; - dest[(*j)] = src[(*i)]; - (*j) += 1; - (*i) += 1; - } - } -} - - -/* - Cast - casts a := b -*/ - -static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (b, b_, _b_high+1); - - if (_a_high == _b_high) - { - for (i=0; i<=_a_high; i++) - { - a[i] = b[i]; - } - } - else - { - FormatError ((const char *) "cast failed", 11); - } -} - - -/* - StringFormat1 - converts string, src, into, dest, together with encapsulated - entity, w. It only formats the first %s or %d with n. -*/ - -static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high) -{ - typedef struct StringFormat1__T8_a StringFormat1__T8; - - typedef char *StringFormat1__T4; - - struct StringFormat1__T8_a { char array[MaxErrorString+1]; }; - unsigned int HighSrc; - unsigned int HighDest; - unsigned int c; - unsigned int i; - unsigned int j; - StringFormat1__T8 str; - StringFormat1__T4 p; - char src[_src_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (src, src_, _src_high+1); - memcpy (w, w_, _w_high+1); - - HighSrc = StrLib_StrLen ((const char *) src, _src_high); - HighDest = _dest_high; - p = NULL; - c = 0; - i = 0; - j = 0; - while ((((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) && (src[i] != '%')) - { - if (src[i] == '\\') - { - HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest); - } - else - { - dest[j] = src[i]; - i += 1; - j += 1; - } - } - if ((((i+1) < HighSrc) && (src[i] == '%')) && (j < HighDest)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (src[i+1] == 's') - { - Cast ((unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) w, _w_high); - while ((j < HighDest) && ((*p) != ASCII_nul)) - { - dest[j] = (*p); - j += 1; - p += 1; - } - if (j < HighDest) - { - dest[j] = ASCII_nul; - } - j = StrLib_StrLen ((const char *) dest, _dest_high); - i += 2; - } - else if (src[i+1] == 'd') - { - /* avoid dangling else. */ - dest[j] = ASCII_nul; - Cast ((unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) w, _w_high); - NumberIO_CardToStr (c, 0, (char *) &str.array[0], MaxErrorString); - StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxErrorString, (char *) dest, _dest_high); - j = StrLib_StrLen ((const char *) dest, _dest_high); - i += 2; - } - else - { - /* avoid dangling else. */ - dest[j] = src[i]; - i += 1; - j += 1; - } - } - /* and finish off copying src into dest */ - while (((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) - { - if (src[i] == '\\') - { - HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest); - } - else - { - dest[j] = src[i]; - i += 1; - j += 1; - } - } - if (j < HighDest) - { - dest[j] = ASCII_nul; - } -} - - -/* - FormatError - provides a orthoganal counterpart to the procedure below. -*/ - -static void FormatError (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - FIO_WriteString (FIO_StdErr, (const char *) a, _a_high); -} - - -/* - FormatError1 - generic error procedure taking standard format string - and single parameter. -*/ - -static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high) -{ - typedef struct FormatError1__T9_a FormatError1__T9; - - struct FormatError1__T9_a { char array[MaxErrorString+1]; }; - FormatError1__T9 s; - char a[_a_high+1]; - unsigned char w[_w_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w, w_, _w_high+1); - - StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w, _w_high); - FormatError ((const char *) &s.array[0], MaxErrorString); -} - - -/* - FormatError2 - generic error procedure taking standard format string - and two parameters. -*/ - -static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high) -{ - typedef struct FormatError2__T10_a FormatError2__T10; - - struct FormatError2__T10_a { char array[MaxErrorString+1]; }; - FormatError2__T10 s; - char a[_a_high+1]; - unsigned char w1[_w1_high+1]; - unsigned char w2[_w2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (w1, w1_, _w1_high+1); - memcpy (w2, w2_, _w2_high+1); - - StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high); - FormatError1 ((const char *) &s.array[0], MaxErrorString, (const unsigned char *) w2, _w2_high); -} - - -/* - CheckAccess - checks to see whether a file f has been - opened for read/write. -*/ - -static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - /* avoid dangling else. */ - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - if (f != FIO_StdErr) - { - FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96); - } - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - if ((use == FIO_openedforwrite) && (fd->usage == FIO_openedforread)) - { - FormatError1 ((const char *) "this file (%s) has been opened for reading but is now being written\\n", 69, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else if ((use == FIO_openedforread) && (fd->usage == FIO_openedforwrite)) - { - /* avoid dangling else. */ - FormatError1 ((const char *) "this file (%s) has been opened for writing but is now being read\\n", 66, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else if (fd->state == FIO_connectionfailure) - { - /* avoid dangling else. */ - FormatError1 ((const char *) "this file (%s) was not successfully opened\\n", 44, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else if (towrite != fd->output) - { - /* avoid dangling else. */ - if (fd->output) - { - FormatError1 ((const char *) "this file (%s) was opened for writing but is now being read\\n", 61, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - FormatError1 ((const char *) "this file (%s) was opened for reading but is now being written\\n", 64, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - } - } - else - { - FormatError ((const char *) "this file has not been opened successfully\\n", 44); - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - SetEndOfLine - -*/ - -static void SetEndOfLine (FIO_File f, char ch) -{ - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforread, FALSE); - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (ch == ASCII_nl) - { - fd->state = FIO_endofline; - } - else - { - fd->state = FIO_successful; - } - } -} - - -/* - BufferedWrite - will write, nBytes, through the buffer. - Similar to WriteNBytes, but this function will always - write into the buffer before copying into memory. - - Useful when performing small writes. -*/ - -static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a) -{ - typedef unsigned char *BufferedWrite__T5; - - void * t; - int result; - int total; - int n; - BufferedWrite__T5 p; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - total = 0; /* how many bytes have we read */ - if (fd->buffer != NULL) /* how many bytes have we read */ - { - /* place into the buffer first */ - while (nBytes > 0) - { - if (fd->buffer->left > 0) - { - if (nBytes == 1) - { - /* too expensive to call memcpy for 1 character */ - p = static_cast (a); - (*fd->buffer->contents).array[fd->buffer->position] = static_cast ((*p)); - fd->buffer->left -= 1; /* reduce space */ - fd->buffer->position += 1; /* move onwards n byte */ - total += 1; /* move onwards n byte */ - return total; - } - else - { - n = Min (fd->buffer->left, nBytes); - t = fd->buffer->address; - t = reinterpret_cast (reinterpret_cast (t)+fd->buffer->position); - p = static_cast (libc_memcpy (a, t, static_cast ((unsigned int ) (n)))); - fd->buffer->left -= n; /* remove consumed bytes */ - fd->buffer->position += n; /* move onwards n bytes */ - /* move ready for further writes */ - a = reinterpret_cast (reinterpret_cast (a)+n); - nBytes -= n; /* reduce the amount for future writes */ - total += n; /* reduce the amount for future writes */ - } - } - else - { - FIO_FlushBuffer (f); - if ((fd->state != FIO_successful) && (fd->state != FIO_endofline)) - { - nBytes = 0; - } - } - } - return total; - } - } - } - return -1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PreInitialize - preinitialize the file descriptor. -*/ - -static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize) -{ - FIO_FileDescriptor fd; - FIO_FileDescriptor fe; - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - if ((InitializeFile (f, &fname, StrLib_StrLen ((const char *) fname, _fname_high), state, use, towrite, bufsize)) == f) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (f == Error) - { - fe = static_cast (Indexing_GetIndice (FileInfo, FIO_StdErr)); - if (fe == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - fd->unixfd = fe->unixfd; /* the error channel */ - } - } - else - { - fd->unixfd = osfd; - } - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - Init - initialize the modules, global variables. -*/ - -static void Init (void) -{ - FileInfo = Indexing_InitIndex (0); - Error = 0; - PreInitialize (Error, (const char *) "error", 5, FIO_toomanyfilesopen, FIO_unused, FALSE, -1, 0); - FIO_StdIn = 1; - PreInitialize (FIO_StdIn, (const char *) "", 7, FIO_successful, FIO_openedforread, FALSE, 0, MaxBufferLength); - FIO_StdOut = 2; - PreInitialize (FIO_StdOut, (const char *) "", 8, FIO_successful, FIO_openedforwrite, TRUE, 1, MaxBufferLength); - FIO_StdErr = 3; - PreInitialize (FIO_StdErr, (const char *) "", 8, FIO_successful, FIO_openedforwrite, TRUE, 2, MaxBufferLength); - if (! (M2RTS_InstallTerminationProcedure ((PROC ) {(PROC_t) FIO_FlushOutErr}))) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - IsNoError - returns a TRUE if no error has occured on file, f. -*/ - -extern "C" unsigned int FIO_IsNoError (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f == Error) - { - return FALSE; - } - else - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - return (fd != NULL) && (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsActive - returns TRUE if the file, f, is still active. -*/ - -extern "C" unsigned int FIO_IsActive (FIO_File f) -{ - if (f == Error) - { - return FALSE; - } - else - { - return (Indexing_GetIndice (FileInfo, f)) != NULL; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high) -{ - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - /* - The following functions are wrappers for the above. - */ - return FIO_exists (&fname, StrLib_StrLen ((const char *) fname, _fname_high)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high) -{ - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - return FIO_openToRead (&fname, StrLib_StrLen ((const char *) fname, _fname_high)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high) -{ - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - return FIO_openToWrite (&fname, StrLib_StrLen ((const char *) fname, _fname_high)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile) -{ - char fname[_fname_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (fname, fname_, _fname_high+1); - - return FIO_openForRandom (&fname, StrLib_StrLen ((const char *) fname, _fname_high), towrite, newfile); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Close - close a file which has been previously opened using: - OpenToRead, OpenToWrite, OpenForRandom. - It is correct to close a file which has an error status. -*/ - -extern "C" void FIO_Close (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - /* - we allow users to close files which have an error status - */ - if (fd != NULL) - { - FIO_FlushBuffer (f); - if (fd->unixfd >= 0) - { - if ((libc_close (fd->unixfd)) != 0) - { - FormatError1 ((const char *) "failed to close file (%s)\\n", 27, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1)); - fd->state = FIO_failed; /* --fixme-- too late to notify user (unless we return a BOOLEAN) */ - } - } - if (fd->name.address != NULL) - { - Storage_DEALLOCATE (&fd->name.address, fd->name.size); - } - if (fd->buffer != NULL) - { - if (fd->buffer->address != NULL) - { - Storage_DEALLOCATE (&fd->buffer->address, fd->buffer->size); - } - Storage_DEALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf)); - fd->buffer = NULL; - } - Storage_DEALLOCATE ((void **) &fd, sizeof (FIO_fds)); - Indexing_PutIndice (FileInfo, f, NULL); - } - } -} - - -/* - exists - returns TRUE if a file named, fname exists for reading. -*/ - -extern "C" unsigned int FIO_exists (void * fname, unsigned int flength) -{ - FIO_File f; - - f = FIO_openToRead (fname, flength); - if (FIO_IsNoError (f)) - { - FIO_Close (f); - return TRUE; - } - else - { - FIO_Close (f); - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openToRead - attempts to open a file, fname, for reading and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength) -{ - FIO_File f; - - f = GetNextFreeDescriptor (); - if (f == Error) - { - SetState (f, FIO_toomanyfilesopen); - } - else - { - f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforread, FALSE, MaxBufferLength); - ConnectToUnix (f, FALSE, FALSE); - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openToWrite - attempts to open a file, fname, for write and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength) -{ - FIO_File f; - - f = GetNextFreeDescriptor (); - if (f == Error) - { - SetState (f, FIO_toomanyfilesopen); - } - else - { - f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforwrite, TRUE, MaxBufferLength); - ConnectToUnix (f, TRUE, TRUE); - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - openForRandom - attempts to open a file, fname, for random access - read or write and it returns this file. - The success of this operation can be checked by - calling IsNoError. - towrite, determines whether the file should be - opened for writing or reading. -*/ - -extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile) -{ - FIO_File f; - - f = GetNextFreeDescriptor (); - if (f == Error) - { - SetState (f, FIO_toomanyfilesopen); - } - else - { - f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforrandom, towrite, MaxBufferLength); - ConnectToUnix (f, towrite, newfile); - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FlushBuffer - flush contents of file, f. -*/ - -extern "C" void FIO_FlushBuffer (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - if (fd->output && (fd->buffer != NULL)) - { - if ((fd->buffer->position == 0) || ((libc_write (fd->unixfd, fd->buffer->address, static_cast (fd->buffer->position))) == ((int ) (fd->buffer->position)))) - { - fd->abspos += fd->buffer->position; - fd->buffer->bufstart = fd->abspos; - fd->buffer->position = 0; - fd->buffer->filled = 0; - fd->buffer->left = fd->buffer->size; - } - else - { - fd->state = FIO_failed; - } - } - } - } -} - - -/* - ReadNBytes - reads nBytes of a file into memory area, dest, returning - the number of bytes actually read. - This function will consume from the buffer and then - perform direct libc reads. It is ideal for large reads. -*/ - -extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest) -{ - typedef char *ReadNBytes__T2; - - int n; - ReadNBytes__T2 p; - - if (f != Error) - { - CheckAccess (f, FIO_openedforread, FALSE); - n = ReadFromBuffer (f, dest, nBytes); - if (n <= 0) - { - return 0; - } - else - { - p = static_cast (dest); - p += n-1; - SetEndOfLine (f, (*p)); - return n; - } - } - else - { - return 0; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ReadAny - reads HIGH(a) bytes into, a. All input - is fully buffered, unlike ReadNBytes and thus is more - suited to small reads. -*/ - -extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high) -{ - CheckAccess (f, FIO_openedforread, FALSE); - if ((BufferedRead (f, _a_high, a)) == ((int ) (_a_high))) - { - SetEndOfLine (f, static_cast (a[_a_high])); - } -} - - -/* - WriteNBytes - writes nBytes from memory area src to a file - returning the number of bytes actually written. - This function will flush the buffer and then - write the nBytes using a direct write from libc. - It is ideal for large writes. -*/ - -extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src) -{ - int total; - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforwrite, TRUE); - FIO_FlushBuffer (f); - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - total = static_cast (libc_write (fd->unixfd, src, static_cast ((int ) (nBytes)))); - if (total < 0) - { - fd->state = FIO_failed; - return 0; - } - else - { - fd->abspos += (unsigned int ) (total); - if (fd->buffer != NULL) - { - fd->buffer->bufstart = fd->abspos; - } - return (unsigned int ) (total); - } - } - } - return 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WriteAny - writes HIGH(a) bytes onto, file, f. All output - is fully buffered, unlike WriteNBytes and thus is more - suited to small writes. -*/ - -extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high) -{ - CheckAccess (f, FIO_openedforwrite, TRUE); - if ((BufferedWrite (f, _a_high, a)) == ((int ) (_a_high))) - {} /* empty. */ -} - - -/* - WriteChar - writes a single character to file, f. -*/ - -extern "C" void FIO_WriteChar (FIO_File f, char ch) -{ - CheckAccess (f, FIO_openedforwrite, TRUE); - if ((BufferedWrite (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch)))) - {} /* empty. */ -} - - -/* - EOF - tests to see whether a file, f, has reached end of file. -*/ - -extern "C" unsigned int FIO_EOF (FIO_File f) -{ - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforread, FALSE); - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - return fd->state == FIO_endoffile; - } - } - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EOLN - tests to see whether a file, f, is upon a newline. - It does NOT consume the newline. -*/ - -extern "C" unsigned int FIO_EOLN (FIO_File f) -{ - char ch; - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforread, FALSE); - /* - we will read a character and then push it back onto the input stream, - having noted the file status, we also reset the status. - */ - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - if ((fd->state == FIO_successful) || (fd->state == FIO_endofline)) - { - ch = FIO_ReadChar (f); - if ((fd->state == FIO_successful) || (fd->state == FIO_endofline)) - { - FIO_UnReadChar (f, ch); - } - return ch == ASCII_nl; - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WasEOLN - tests to see whether a file, f, has just seen a newline. -*/ - -extern "C" unsigned int FIO_WasEOLN (FIO_File f) -{ - FIO_FileDescriptor fd; - - CheckAccess (f, FIO_openedforread, FALSE); - if (f == Error) - { - return FALSE; - } - else - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - return (fd != NULL) && (fd->state == FIO_endofline); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ReadChar - returns a character read from file f. - Sensible to check with IsNoError or EOF after calling - this function. -*/ - -extern "C" char FIO_ReadChar (FIO_File f) -{ - char ch; - - CheckAccess (f, FIO_openedforread, FALSE); - if ((BufferedRead (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch)))) - { - SetEndOfLine (f, ch); - return ch; - } - else - { - return ASCII_nul; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - UnReadChar - replaces a character, ch, back into file f. - This character must have been read by ReadChar - and it does not allow successive calls. It may - only be called if the previous read was successful - or end of file was seen. - If the state was previously endoffile then it - is altered to successful. - Otherwise it is left alone. -*/ - -extern "C" void FIO_UnReadChar (FIO_File f, char ch) -{ - FIO_FileDescriptor fd; - unsigned int n; - void * a; - void * b; - - CheckAccess (f, FIO_openedforread, FALSE); - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline)) - { - /* avoid dangling else. */ - if ((fd->buffer != NULL) && fd->buffer->valid) - { - /* we assume that a ReadChar has occurred, we will check just in case. */ - if (fd->state == FIO_endoffile) - { - fd->buffer->position = MaxBufferLength; - fd->buffer->left = 0; - fd->buffer->filled = 0; - fd->state = FIO_successful; - } - if (fd->buffer->position > 0) - { - fd->buffer->position -= 1; - fd->buffer->left += 1; - (*fd->buffer->contents).array[fd->buffer->position] = ch; - } - else - { - /* if possible make room and store ch */ - if (fd->buffer->filled == fd->buffer->size) - { - FormatError1 ((const char *) "performing too many UnReadChar calls on file (%d)\\n", 51, (const unsigned char *) &f, (sizeof (f)-1)); - } - else - { - n = fd->buffer->filled-fd->buffer->position; - b = &(*fd->buffer->contents).array[fd->buffer->position]; - a = &(*fd->buffer->contents).array[fd->buffer->position+1]; - a = libc_memcpy (a, b, static_cast (n)); - fd->buffer->filled += 1; - (*fd->buffer->contents).array[fd->buffer->position] = ch; - } - } - } - } - else - { - FormatError1 ((const char *) "UnReadChar can only be called if the previous read was successful or end of file, error on file (%d)\\n", 102, (const unsigned char *) &f, (sizeof (f)-1)); - } - } -} - - -/* - WriteLine - writes out a linefeed to file, f. -*/ - -extern "C" void FIO_WriteLine (FIO_File f) -{ - FIO_WriteChar (f, ASCII_nl); -} - - -/* - WriteString - writes a string to file, f. -*/ - -extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high) -{ - unsigned int l; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - l = StrLib_StrLen ((const char *) a, _a_high); - if ((FIO_WriteNBytes (f, l, &a)) != l) - {} /* empty. */ -} - - -/* - ReadString - reads a string from file, f, into string, a. - It terminates the string if HIGH is reached or - if a newline is seen or an error occurs. -*/ - -extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high) -{ - unsigned int high; - unsigned int i; - char ch; - - CheckAccess (f, FIO_openedforread, FALSE); - high = _a_high; - i = 0; - do { - ch = FIO_ReadChar (f); - if (i <= high) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (((ch == ASCII_nl) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f))) - { - a[i] = ASCII_nul; - i += 1; - } - else - { - a[i] = ch; - i += 1; - } - } - } while (! ((((ch == ASCII_nl) || (i > high)) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f)))); -} - - -/* - WriteCardinal - writes a CARDINAL to file, f. - It writes the binary image of the cardinal - to file, f. -*/ - -extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c) -{ - FIO_WriteAny (f, (unsigned char *) &c, (sizeof (c)-1)); -} - - -/* - ReadCardinal - reads a CARDINAL from file, f. - It reads a binary image of a CARDINAL - from a file, f. -*/ - -extern "C" unsigned int FIO_ReadCardinal (FIO_File f) -{ - unsigned int c; - - FIO_ReadAny (f, (unsigned char *) &c, (sizeof (c)-1)); - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetUnixFileDescriptor - returns the UNIX file descriptor of a file. -*/ - -extern "C" int FIO_GetUnixFileDescriptor (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - return fd->unixfd; - } - } - FormatError1 ((const char *) "file %d has not been opened or is out of range\\n", 48, (const unsigned char *) &f, (sizeof (f)-1)); - return -1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SetPositionFromBeginning - sets the position from the beginning of the file. -*/ - -extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos) -{ - long int offset; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - /* always force the lseek, until we are confident that abspos is always correct, - basically it needs some hard testing before we should remove the OR TRUE. */ - if ((fd->abspos != pos) || TRUE) - { - FIO_FlushBuffer (f); - if (fd->buffer != NULL) - { - if (fd->output) - { - fd->buffer->left = fd->buffer->size; - } - else - { - fd->buffer->left = 0; - } - fd->buffer->position = 0; - fd->buffer->filled = 0; - } - offset = libc_lseek (fd->unixfd, pos, SEEK_SET); - if ((offset >= 0) && (pos == offset)) - { - fd->abspos = pos; - } - else - { - fd->state = FIO_failed; - fd->abspos = 0; - } - if (fd->buffer != NULL) - { - fd->buffer->valid = FALSE; - fd->buffer->bufstart = fd->abspos; - } - } - } - } -} - - -/* - SetPositionFromEnd - sets the position from the end of the file. -*/ - -extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos) -{ - long int offset; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - FIO_FlushBuffer (f); - if (fd->buffer != NULL) - { - if (fd->output) - { - fd->buffer->left = fd->buffer->size; - } - else - { - fd->buffer->left = 0; - } - fd->buffer->position = 0; - fd->buffer->filled = 0; - } - offset = libc_lseek (fd->unixfd, pos, SEEK_END); - if (offset >= 0) - { - fd->abspos = offset; - } - else - { - fd->state = FIO_failed; - fd->abspos = 0; - offset = 0; - } - if (fd->buffer != NULL) - { - fd->buffer->valid = FALSE; - fd->buffer->bufstart = offset; - } - } - } -} - - -/* - FindPosition - returns the current absolute position in file, f. -*/ - -extern "C" long int FIO_FindPosition (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd != NULL) - { - if ((fd->buffer == NULL) || ! fd->buffer->valid) - { - return fd->abspos; - } - else - { - return fd->buffer->bufstart+((long int ) (fd->buffer->position)); - } - } - } - return 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetFileName - assigns, a, with the filename associated with, f. -*/ - -extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high) -{ - typedef char *GetFileName__T6; - - unsigned int i; - GetFileName__T6 p; - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - if (fd->name.address == NULL) - { - StrLib_StrCopy ((const char *) "", 0, (char *) a, _a_high); - } - else - { - p = static_cast (fd->name.address); - i = 0; - while (((*p) != ASCII_nul) && (i <= _a_high)) - { - a[i] = (*p); - p += 1; - i += 1; - } - } - } - } -} - - -/* - getFileName - returns the address of the filename associated with, f. -*/ - -extern "C" void * FIO_getFileName (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return fd->name.address; - } - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - getFileNameLength - returns the number of characters associated with filename, f. -*/ - -extern "C" unsigned int FIO_getFileNameLength (FIO_File f) -{ - FIO_FileDescriptor fd; - - if (f != Error) - { - fd = static_cast (Indexing_GetIndice (FileInfo, f)); - if (fd == NULL) - { - FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return fd->name.size; - } - } - return 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FlushOutErr - flushes, StdOut, and, StdErr. - It is also called when the application calls M2RTS.Terminate. - (which is automatically placed in program modules by the GM2 - scaffold). -*/ - -extern "C" void FIO_FlushOutErr (void) -{ - if (FIO_IsNoError (FIO_StdOut)) - { - FIO_FlushBuffer (FIO_StdOut); - } - if (FIO_IsNoError (FIO_StdErr)) - { - FIO_FlushBuffer (FIO_StdErr); - } -} - -extern "C" void _M2_FIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_FIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - FIO_FlushOutErr (); -} diff --git a/gcc/m2/pge-boot/GIO.c b/gcc/m2/pge-boot/GIO.c deleted file mode 100644 index 1d670569c2a7..000000000000 --- a/gcc/m2/pge-boot/GIO.c +++ /dev/null @@ -1,479 +0,0 @@ -/* do not edit automatically generated by mc from IO. */ -/* IO.mod provides Read, Write, Errors procedures mapping onto 0, 1 and 2. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#define _IO_H -#define _IO_C - -# include "GStrLib.h" -# include "GSYSTEM.h" -# include "Glibc.h" -# include "GFIO.h" -# include "Gerrno.h" -# include "GASCII.h" -# include "Gtermios.h" - -# define MaxDefaultFd 2 -typedef struct IO_BasicFds_r IO_BasicFds; - -typedef struct IO__T1_a IO__T1; - -struct IO_BasicFds_r { - unsigned int IsEof; - unsigned int IsRaw; - }; - -struct IO__T1_a { IO_BasicFds array[MaxDefaultFd+1]; }; -static IO__T1 fdState; - -/* - IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2. -*/ - -extern "C" void IO_Read (char *ch); - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -extern "C" void IO_Write (char ch); - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -extern "C" void IO_Error (char ch); -extern "C" void IO_UnBufferedMode (int fd, unsigned int input); -extern "C" void IO_BufferedMode (int fd, unsigned int input); - -/* - EchoOn - turns on echoing for file descriptor, fd. This - only really makes sence for a file descriptor opened - for terminal input or maybe some specific file descriptor - which is attached to a particular piece of hardware. -*/ - -extern "C" void IO_EchoOn (int fd, unsigned int input); - -/* - EchoOff - turns off echoing for file descriptor, fd. This - only really makes sence for a file descriptor opened - for terminal input or maybe some specific file descriptor - which is attached to a particular piece of hardware. -*/ - -extern "C" void IO_EchoOff (int fd, unsigned int input); - -/* - IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2. -*/ - -static unsigned int IsDefaultFd (int fd); - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -static void doWrite (int fd, FIO_File f, char ch); - -/* - setFlag - sets or unsets the appropriate flag in, t. -*/ - -static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b); - -/* - doraw - sets all the flags associated with making this - file descriptor into raw input/output. -*/ - -static void doraw (termios_TERMIOS term); - -/* - dononraw - sets all the flags associated with making this - file descriptor into non raw input/output. -*/ - -static void dononraw (termios_TERMIOS term); - -/* - Init - -*/ - -static void Init (void); - - -/* - IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2. -*/ - -static unsigned int IsDefaultFd (int fd) -{ - return (fd <= MaxDefaultFd) && (fd >= 0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -static void doWrite (int fd, FIO_File f, char ch) -{ - int r; - - if (fdState.array[fd].IsRaw) - { - /* avoid dangling else. */ - if (! fdState.array[fd].IsEof) - { - for (;;) - { - r = static_cast (libc_write (FIO_GetUnixFileDescriptor (f), &ch, static_cast (1))); - if (r == 1) - { - return ; - } - else if (r == -1) - { - /* avoid dangling else. */ - r = errno_geterrno (); - if ((r != errno_EAGAIN) && (r != errno_EINTR)) - { - fdState.array[fd].IsEof = TRUE; - return ; - } - } - } - } - } - else - { - FIO_WriteChar (f, ch); - } -} - - -/* - setFlag - sets or unsets the appropriate flag in, t. -*/ - -static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b) -{ - if (termios_SetFlag (t, f, b)) - {} /* empty. */ -} - - -/* - doraw - sets all the flags associated with making this - file descriptor into raw input/output. -*/ - -static void doraw (termios_TERMIOS term) -{ - /* - * from man 3 termios - * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP - * | INLCR | IGNCR | ICRNL | IXON); - * termios_p->c_oflag &= ~OPOST; - * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN); - * termios_p->c_cflag &= ~(CSIZE | PARENB); - * termios_p->c_cflag |= CS8; - */ - setFlag (term, termios_ignbrk, FALSE); - setFlag (term, termios_ibrkint, FALSE); - setFlag (term, termios_iparmrk, FALSE); - setFlag (term, termios_istrip, FALSE); - setFlag (term, termios_inlcr, FALSE); - setFlag (term, termios_igncr, FALSE); - setFlag (term, termios_icrnl, FALSE); - setFlag (term, termios_ixon, FALSE); - setFlag (term, termios_opost, FALSE); - setFlag (term, termios_lecho, FALSE); - setFlag (term, termios_lechonl, FALSE); - setFlag (term, termios_licanon, FALSE); - setFlag (term, termios_lisig, FALSE); - setFlag (term, termios_liexten, FALSE); - setFlag (term, termios_parenb, FALSE); - setFlag (term, termios_cs8, TRUE); -} - - -/* - dononraw - sets all the flags associated with making this - file descriptor into non raw input/output. -*/ - -static void dononraw (termios_TERMIOS term) -{ - /* - * we undo these settings, (although we leave the character size alone) - * - * from man 3 termios - * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP - * | INLCR | IGNCR | ICRNL | IXON); - * termios_p->c_oflag &= ~OPOST; - * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN); - * termios_p->c_cflag &= ~(CSIZE | PARENB); - * termios_p->c_cflag |= CS8; - */ - setFlag (term, termios_ignbrk, TRUE); - setFlag (term, termios_ibrkint, TRUE); - setFlag (term, termios_iparmrk, TRUE); - setFlag (term, termios_istrip, TRUE); - setFlag (term, termios_inlcr, TRUE); - setFlag (term, termios_igncr, TRUE); - setFlag (term, termios_icrnl, TRUE); - setFlag (term, termios_ixon, TRUE); - setFlag (term, termios_opost, TRUE); - setFlag (term, termios_lecho, TRUE); - setFlag (term, termios_lechonl, TRUE); - setFlag (term, termios_licanon, TRUE); - setFlag (term, termios_lisig, TRUE); - setFlag (term, termios_liexten, TRUE); -} - - -/* - Init - -*/ - -static void Init (void) -{ - fdState.array[0].IsEof = FALSE; - fdState.array[0].IsRaw = FALSE; - fdState.array[1].IsEof = FALSE; - fdState.array[1].IsRaw = FALSE; - fdState.array[2].IsEof = FALSE; - fdState.array[2].IsRaw = FALSE; -} - - -/* - IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2. -*/ - -extern "C" void IO_Read (char *ch) -{ - int r; - - FIO_FlushBuffer (FIO_StdOut); - FIO_FlushBuffer (FIO_StdErr); - if (fdState.array[0].IsRaw) - { - if (fdState.array[0].IsEof) - { - (*ch) = ASCII_eof; - } - else - { - for (;;) - { - r = static_cast (libc_read (FIO_GetUnixFileDescriptor (FIO_StdIn), ch, static_cast (1))); - if (r == 1) - { - return ; - } - else if (r == -1) - { - /* avoid dangling else. */ - r = errno_geterrno (); - if (r != errno_EAGAIN) - { - fdState.array[0].IsEof = TRUE; - (*ch) = ASCII_eof; - return ; - } - } - } - } - } - else - { - (*ch) = FIO_ReadChar (FIO_StdIn); - } -} - - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -extern "C" void IO_Write (char ch) -{ - doWrite (1, FIO_StdOut, ch); -} - - -/* - doWrite - performs the write of a single character, ch, - onto fd or f. -*/ - -extern "C" void IO_Error (char ch) -{ - doWrite (2, FIO_StdErr, ch); -} - -extern "C" void IO_UnBufferedMode (int fd, unsigned int input) -{ - termios_TERMIOS term; - int result; - - if (IsDefaultFd (fd)) - { - fdState.array[fd].IsRaw = TRUE; - } - term = termios_InitTermios (); - if ((termios_tcgetattr (fd, term)) == 0) - { - doraw (term); - if (input) - { - result = termios_tcsetattr (fd, termios_tcsflush (), term); - } - else - { - result = termios_tcsetattr (fd, termios_tcsdrain (), term); - } - } - term = termios_KillTermios (term); -} - -extern "C" void IO_BufferedMode (int fd, unsigned int input) -{ - termios_TERMIOS term; - int r; - - if (IsDefaultFd (fd)) - { - fdState.array[fd].IsRaw = FALSE; - } - term = termios_InitTermios (); - if ((termios_tcgetattr (fd, term)) == 0) - { - dononraw (term); - if (input) - { - r = termios_tcsetattr (fd, termios_tcsflush (), term); - } - else - { - r = termios_tcsetattr (fd, termios_tcsdrain (), term); - } - } - term = termios_KillTermios (term); -} - - -/* - EchoOn - turns on echoing for file descriptor, fd. This - only really makes sence for a file descriptor opened - for terminal input or maybe some specific file descriptor - which is attached to a particular piece of hardware. -*/ - -extern "C" void IO_EchoOn (int fd, unsigned int input) -{ - termios_TERMIOS term; - int result; - - term = termios_InitTermios (); - if ((termios_tcgetattr (fd, term)) == 0) - { - setFlag (term, termios_lecho, TRUE); - if (input) - { - result = termios_tcsetattr (fd, termios_tcsflush (), term); - } - else - { - result = termios_tcsetattr (fd, termios_tcsdrain (), term); - } - } - term = termios_KillTermios (term); -} - - -/* - EchoOff - turns off echoing for file descriptor, fd. This - only really makes sence for a file descriptor opened - for terminal input or maybe some specific file descriptor - which is attached to a particular piece of hardware. -*/ - -extern "C" void IO_EchoOff (int fd, unsigned int input) -{ - termios_TERMIOS term; - int result; - - term = termios_InitTermios (); - if ((termios_tcgetattr (fd, term)) == 0) - { - setFlag (term, termios_lecho, FALSE); - if (input) - { - result = termios_tcsetattr (fd, termios_tcsflush (), term); - } - else - { - result = termios_tcsetattr (fd, termios_tcsdrain (), term); - } - } - term = termios_KillTermios (term); -} - -extern "C" void _M2_IO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_IO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GIndexing.c b/gcc/m2/pge-boot/GIndexing.c deleted file mode 100644 index 630feb7c6943..000000000000 --- a/gcc/m2/pge-boot/GIndexing.c +++ /dev/null @@ -1,493 +0,0 @@ -/* do not edit automatically generated by mc from Indexing. */ -/* Indexing.mod provides a dynamic indexing mechanism for CARDINAL. - -Copyright (C) 2003-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _Indexing_H -#define _Indexing_C - -# include "Glibc.h" -# include "GStorage.h" -# include "GSYSTEM.h" -# include "GM2RTS.h" - -typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure; - -# define MinSize 128 -typedef struct Indexing__T2_r Indexing__T2; - -typedef void * *Indexing_PtrToAddress; - -typedef Indexing__T2 *Indexing_Index; - -typedef unsigned char *Indexing_PtrToByte; - -typedef void (*Indexing_IndexProcedure_t) (void *); -struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; }; - -struct Indexing__T2_r { - void *ArrayStart; - unsigned int ArraySize; - unsigned int Used; - unsigned int Low; - unsigned int High; - unsigned int Debug; - unsigned int Map; - }; - - -/* - InitIndex - creates and returns an Index. -*/ - -extern "C" Indexing_Index Indexing_InitIndex (unsigned int low); - -/* - KillIndex - returns Index to free storage. -*/ - -extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i); - -/* - DebugIndex - turns on debugging within an index. -*/ - -extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i); - -/* - InBounds - returns TRUE if indice, n, is within the bounds - of the dynamic array. -*/ - -extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n); - -/* - HighIndice - returns the last legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_HighIndice (Indexing_Index i); - -/* - LowIndice - returns the first legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_LowIndice (Indexing_Index i); - -/* - PutIndice - places, a, into the dynamic array at position i[n] -*/ - -extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a); - -/* - GetIndice - retrieves, element i[n] from the dynamic array. -*/ - -extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n); - -/* - IsIndiceInIndex - returns TRUE if, a, is in the index, i. -*/ - -extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a); - -/* - RemoveIndiceFromIndex - removes, a, from Index, i. -*/ - -extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a); - -/* - DeleteIndice - delete i[j] from the array. -*/ - -extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j); - -/* - IncludeIndiceIntoIndex - if the indice is not in the index, then - add it at the end. -*/ - -extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a); - -/* - ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j]) -*/ - -extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p); - - -/* - InitIndex - creates and returns an Index. -*/ - -extern "C" Indexing_Index Indexing_InitIndex (unsigned int low) -{ - Indexing_Index i; - - Storage_ALLOCATE ((void **) &i, sizeof (Indexing__T2)); - i->Low = low; - i->High = 0; - i->ArraySize = MinSize; - Storage_ALLOCATE (&i->ArrayStart, MinSize); - i->ArrayStart = libc_memset (i->ArrayStart, 0, static_cast (i->ArraySize)); - i->Debug = FALSE; - i->Used = 0; - i->Map = (unsigned int) 0; - return i; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillIndex - returns Index to free storage. -*/ - -extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i) -{ - Storage_DEALLOCATE (&i->ArrayStart, i->ArraySize); - Storage_DEALLOCATE ((void **) &i, sizeof (Indexing__T2)); - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DebugIndex - turns on debugging within an index. -*/ - -extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i) -{ - i->Debug = TRUE; - return i; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InBounds - returns TRUE if indice, n, is within the bounds - of the dynamic array. -*/ - -extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n) -{ - if (i == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return (n >= i->Low) && (n <= i->High); - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1); - __builtin_unreachable (); -} - - -/* - HighIndice - returns the last legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_HighIndice (Indexing_Index i) -{ - if (i == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return i->High; - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1); - __builtin_unreachable (); -} - - -/* - LowIndice - returns the first legally accessible indice of this array. -*/ - -extern "C" unsigned int Indexing_LowIndice (Indexing_Index i) -{ - if (i == NULL) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - return i->Low; - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1); - __builtin_unreachable (); -} - - -/* - PutIndice - places, a, into the dynamic array at position i[n] -*/ - -extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a) -{ - typedef unsigned int * *PutIndice__T1; - - unsigned int oldSize; - void * b; - PutIndice__T1 p; - - if (! (Indexing_InBounds (i, n))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (n < i->Low) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - oldSize = i->ArraySize; - while (((n-i->Low)*sizeof (void *)) >= i->ArraySize) - { - i->ArraySize = i->ArraySize*2; - } - if (oldSize != i->ArraySize) - { - /* - IF Debug - THEN - printf2('increasing memory hunk from %d to %d - ', - oldSize, ArraySize) - END ; - */ - Storage_REALLOCATE (&i->ArrayStart, i->ArraySize); - /* and initialize the remainder of the array to NIL */ - b = i->ArrayStart; - b = reinterpret_cast (reinterpret_cast (b)+oldSize); - b = libc_memset (b, 0, static_cast (i->ArraySize-oldSize)); - } - i->High = n; - } - } - b = i->ArrayStart; - b = reinterpret_cast (reinterpret_cast (b)+(n-i->Low)*sizeof (void *)); - p = static_cast (b); - (*p) = reinterpret_cast (a); - i->Used += 1; - if (i->Debug) - { - if (n < 32) - { - i->Map |= (1 << (n )); - } - } -} - - -/* - GetIndice - retrieves, element i[n] from the dynamic array. -*/ - -extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n) -{ - Indexing_PtrToByte b; - Indexing_PtrToAddress p; - - if (! (Indexing_InBounds (i, n))) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - b = static_cast (i->ArrayStart); - b += (n-i->Low)*sizeof (void *); - p = (Indexing_PtrToAddress) (b); - if (i->Debug) - { - if (((n < 32) && (! ((((1 << (n)) & (i->Map)) != 0)))) && ((*p) != NULL)) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - } - return (*p); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsIndiceInIndex - returns TRUE if, a, is in the index, i. -*/ - -extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a) -{ - unsigned int j; - Indexing_PtrToByte b; - Indexing_PtrToAddress p; - - j = i->Low; - b = static_cast (i->ArrayStart); - while (j <= i->High) - { - p = (Indexing_PtrToAddress) (b); - if ((*p) == a) - { - return TRUE; - } - /* we must not INC(p, ..) as p2c gets confused */ - b += sizeof (void *); - j += 1; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - RemoveIndiceFromIndex - removes, a, from Index, i. -*/ - -extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a) -{ - unsigned int j; - unsigned int k; - Indexing_PtrToAddress p; - Indexing_PtrToByte b; - - j = i->Low; - b = static_cast (i->ArrayStart); - while (j <= i->High) - { - p = (Indexing_PtrToAddress) (b); - b += sizeof (void *); - if ((*p) == a) - { - Indexing_DeleteIndice (i, j); - } - j += 1; - } -} - - -/* - DeleteIndice - delete i[j] from the array. -*/ - -extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j) -{ - Indexing_PtrToAddress p; - Indexing_PtrToByte b; - - if (Indexing_InBounds (i, j)) - { - b = static_cast (i->ArrayStart); - b += sizeof (void *)*(j-i->Low); - p = (Indexing_PtrToAddress) (b); - b += sizeof (void *); - p = static_cast (libc_memmove (reinterpret_cast (p), reinterpret_cast (b), static_cast ((i->High-j)*sizeof (void *)))); - i->High -= 1; - i->Used -= 1; - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - IncludeIndiceIntoIndex - if the indice is not in the index, then - add it at the end. -*/ - -extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a) -{ - if (! (Indexing_IsIndiceInIndex (i, a))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (i->Used == 0) - { - Indexing_PutIndice (i, Indexing_LowIndice (i), a); - } - else - { - Indexing_PutIndice (i, (Indexing_HighIndice (i))+1, a); - } - } -} - - -/* - ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j]) -*/ - -extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p) -{ - unsigned int j; - - j = Indexing_LowIndice (i); - while (j <= (Indexing_HighIndice (i))) - { - (*p.proc) (Indexing_GetIndice (i, j)); - j += 1; - } -} - -extern "C" void _M2_Indexing_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Indexing_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GLists.c b/gcc/m2/pge-boot/GLists.c deleted file mode 100644 index 45f0ffcb3d32..000000000000 --- a/gcc/m2/pge-boot/GLists.c +++ /dev/null @@ -1,427 +0,0 @@ -/* do not edit automatically generated by mc from Lists. */ -/* Lists.mod provides an unordered list manipulation package. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _Lists_H -#define _Lists_C - -# include "GStorage.h" - -typedef struct SymbolKey_PerformOperation_p SymbolKey_PerformOperation; - -# define MaxNoOfElements 5 -typedef struct Lists_list_r Lists_list; - -typedef struct Lists__T1_a Lists__T1; - -typedef Lists_list *Lists_List; - -typedef void (*SymbolKey_PerformOperation_t) (unsigned int); -struct SymbolKey_PerformOperation_p { SymbolKey_PerformOperation_t proc; }; - -struct Lists__T1_a { unsigned int array[MaxNoOfElements-1+1]; }; -struct Lists_list_r { - unsigned int NoOfElements; - Lists__T1 Elements; - Lists_List Next; - }; - - -/* - InitList - creates a new list, l. -*/ - -extern "C" void Lists_InitList (Lists_List *l); - -/* - KillList - deletes the complete list, l. -*/ - -extern "C" void Lists_KillList (Lists_List *l); - -/* - PutItemIntoList - places a WORD, c, into list, l. -*/ - -extern "C" void Lists_PutItemIntoList (Lists_List l, unsigned int c); -extern "C" unsigned int Lists_GetItemFromList (Lists_List l, unsigned int n); - -/* - GetIndexOfList - returns the index for WORD, c, in list, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int Lists_GetIndexOfList (Lists_List l, unsigned int c); - -/* - NoOfItemsInList - returns the number of items in list, l. - (iterative algorithm of the above). -*/ - -extern "C" unsigned int Lists_NoOfItemsInList (Lists_List l); - -/* - IncludeItemIntoList - adds a WORD, c, into a list providing - the value does not already exist. -*/ - -extern "C" void Lists_IncludeItemIntoList (Lists_List l, unsigned int c); - -/* - RemoveItemFromList - removes a WORD, c, from a list. - It assumes that this value only appears once. -*/ - -extern "C" void Lists_RemoveItemFromList (Lists_List l, unsigned int c); - -/* - IsItemInList - returns true if a WORD, c, was found in list, l. -*/ - -extern "C" unsigned int Lists_IsItemInList (Lists_List l, unsigned int c); - -/* - ForeachItemInListDo - calls procedure, P, foreach item in list, l. -*/ - -extern "C" void Lists_ForeachItemInListDo (Lists_List l, SymbolKey_PerformOperation P); - -/* - DuplicateList - returns a duplicate list derived from, l. -*/ - -extern "C" Lists_List Lists_DuplicateList (Lists_List l); - -/* - RemoveItem - remove an element at index, i, from the list data type. -*/ - -static void RemoveItem (Lists_List p, Lists_List l, unsigned int i); - - -/* - RemoveItem - remove an element at index, i, from the list data type. -*/ - -static void RemoveItem (Lists_List p, Lists_List l, unsigned int i) -{ - l->NoOfElements -= 1; - while (i <= l->NoOfElements) - { - l->Elements.array[i-1] = l->Elements.array[i+1-1]; - i += 1; - } - if ((l->NoOfElements == 0) && (p != NULL)) - { - p->Next = l->Next; - Storage_DEALLOCATE ((void **) &l, sizeof (Lists_list)); - } -} - - -/* - InitList - creates a new list, l. -*/ - -extern "C" void Lists_InitList (Lists_List *l) -{ - Storage_ALLOCATE ((void **) &(*l), sizeof (Lists_list)); - (*l)->NoOfElements = 0; - (*l)->Next = NULL; -} - - -/* - KillList - deletes the complete list, l. -*/ - -extern "C" void Lists_KillList (Lists_List *l) -{ - if ((*l) != NULL) - { - if ((*l)->Next != NULL) - { - Lists_KillList (&(*l)->Next); - } - Storage_DEALLOCATE ((void **) &(*l), sizeof (Lists_list)); - } -} - - -/* - PutItemIntoList - places a WORD, c, into list, l. -*/ - -extern "C" void Lists_PutItemIntoList (Lists_List l, unsigned int c) -{ - if (l->NoOfElements < MaxNoOfElements) - { - l->NoOfElements += 1; - l->Elements.array[l->NoOfElements-1] = c; - } - else if (l->Next != NULL) - { - /* avoid dangling else. */ - Lists_PutItemIntoList (l->Next, c); - } - else - { - /* avoid dangling else. */ - Lists_InitList (&l->Next); - Lists_PutItemIntoList (l->Next, c); - } -} - -extern "C" unsigned int Lists_GetItemFromList (Lists_List l, unsigned int n) -{ - /* iterative solution */ - while (l != NULL) - { - if (n <= l->NoOfElements) - { - return l->Elements.array[n-1]; - } - else - { - n -= l->NoOfElements; - } - l = l->Next; - } - return static_cast (0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetIndexOfList - returns the index for WORD, c, in list, l. - If more than one WORD, c, exists the index - for the first is returned. -*/ - -extern "C" unsigned int Lists_GetIndexOfList (Lists_List l, unsigned int c) -{ - unsigned int i; - - if (l == NULL) - { - return 0; - } - else - { - i = 1; - while (i <= l->NoOfElements) - { - if (l->Elements.array[i-1] == c) - { - return i; - } - else - { - i += 1; - } - } - return l->NoOfElements+(Lists_GetIndexOfList (l->Next, c)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NoOfItemsInList - returns the number of items in list, l. - (iterative algorithm of the above). -*/ - -extern "C" unsigned int Lists_NoOfItemsInList (Lists_List l) -{ - unsigned int t; - - if (l == NULL) - { - return 0; - } - else - { - t = 0; - do { - t += l->NoOfElements; - l = l->Next; - } while (! (l == NULL)); - return t; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IncludeItemIntoList - adds a WORD, c, into a list providing - the value does not already exist. -*/ - -extern "C" void Lists_IncludeItemIntoList (Lists_List l, unsigned int c) -{ - if (! (Lists_IsItemInList (l, c))) - { - Lists_PutItemIntoList (l, c); - } -} - - -/* - RemoveItemFromList - removes a WORD, c, from a list. - It assumes that this value only appears once. -*/ - -extern "C" void Lists_RemoveItemFromList (Lists_List l, unsigned int c) -{ - Lists_List p; - unsigned int i; - unsigned int Found; - - if (l != NULL) - { - Found = FALSE; - p = NULL; - do { - i = 1; - while ((i <= l->NoOfElements) && (l->Elements.array[i-1] != c)) - { - i += 1; - } - if ((i <= l->NoOfElements) && (l->Elements.array[i-1] == c)) - { - Found = TRUE; - } - else - { - p = l; - l = l->Next; - } - } while (! ((l == NULL) || Found)); - if (Found) - { - RemoveItem (p, l, i); - } - } -} - - -/* - IsItemInList - returns true if a WORD, c, was found in list, l. -*/ - -extern "C" unsigned int Lists_IsItemInList (Lists_List l, unsigned int c) -{ - unsigned int i; - - do { - i = 1; - while (i <= l->NoOfElements) - { - if (l->Elements.array[i-1] == c) - { - return TRUE; - } - else - { - i += 1; - } - } - l = l->Next; - } while (! (l == NULL)); - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ForeachItemInListDo - calls procedure, P, foreach item in list, l. -*/ - -extern "C" void Lists_ForeachItemInListDo (Lists_List l, SymbolKey_PerformOperation P) -{ - unsigned int i; - unsigned int n; - - n = Lists_NoOfItemsInList (l); - i = 1; - while (i <= n) - { - (*P.proc) (Lists_GetItemFromList (l, i)); - i += 1; - } -} - - -/* - DuplicateList - returns a duplicate list derived from, l. -*/ - -extern "C" Lists_List Lists_DuplicateList (Lists_List l) -{ - Lists_List m; - unsigned int n; - unsigned int i; - - Lists_InitList (&m); - n = Lists_NoOfItemsInList (l); - i = 1; - while (i <= n) - { - Lists_PutItemIntoList (m, Lists_GetItemFromList (l, i)); - i += 1; - } - return m; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_Lists_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Lists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GM2Dependent.c b/gcc/m2/pge-boot/GM2Dependent.c deleted file mode 100644 index 0e0e3eadcc3d..000000000000 --- a/gcc/m2/pge-boot/GM2Dependent.c +++ /dev/null @@ -1,1410 +0,0 @@ -/* do not edit automatically generated by mc from M2Dependent. */ -/* M2Dependent.mod implements the run time module dependencies. - -Copyright (C) 2022-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -#include -# include "GStorage.h" -#include -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _M2Dependent_H -#define _M2Dependent_C - -# include "Glibc.h" -# include "GM2LINK.h" -# include "GASCII.h" -# include "GSYSTEM.h" -# include "GStorage.h" -# include "GStrLib.h" -# include "GM2RTS.h" - -typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP; - -typedef struct M2Dependent_DependencyList_r M2Dependent_DependencyList; - -typedef struct M2Dependent__T2_r M2Dependent__T2; - -typedef M2Dependent__T2 *M2Dependent_ModuleChain; - -typedef struct M2Dependent__T3_a M2Dependent__T3; - -typedef enum {M2Dependent_unregistered, M2Dependent_unordered, M2Dependent_started, M2Dependent_ordered, M2Dependent_user} M2Dependent_DependencyState; - -typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *); -struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; }; - -struct M2Dependent_DependencyList_r { - PROC proc; - unsigned int forced; - unsigned int forc; - unsigned int appl; - M2Dependent_DependencyState state; - }; - -struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; }; -struct M2Dependent__T2_r { - void *name; - void *libname; - M2Dependent_ArgCVEnvP init; - M2Dependent_ArgCVEnvP fini; - M2Dependent_DependencyList dependency; - M2Dependent_ModuleChain prev; - M2Dependent_ModuleChain next; - }; - -static M2Dependent__T3 Modules; -static unsigned int Initialized; -static unsigned int WarningTrace; -static unsigned int ModuleTrace; -static unsigned int HexTrace; -static unsigned int DependencyTrace; -static unsigned int PreTrace; -static unsigned int PostTrace; -static unsigned int ForceTrace; - -/* - ConstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); - -/* - DeconstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); - -/* - RegisterModule - adds module name to the list of outstanding - modules which need to have their dependencies - explored to determine initialization order. -*/ - -extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies); - -/* - RequestDependant - used to specify that modulename is dependant upon - module dependantmodule. It only takes effect - if we are not using StaticInitialization. -*/ - -extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname); - -/* - CreateModule - creates a new module entry and returns the - ModuleChain. -*/ - -static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies); - -/* - AppendModule - append chain to end of the list. -*/ - -static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain); - -/* - RemoveModule - remove chain from double linked list head. -*/ - -static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain); - -/* - onChain - returns TRUE if mptr is on the Modules[state] list. -*/ - -static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr); - -/* - max - -*/ - -static unsigned int max (unsigned int a, unsigned int b); - -/* - min - -*/ - -static unsigned int min (unsigned int a, unsigned int b); - -/* - LookupModuleN - lookup module from the state list. - The strings lengths are known. -*/ - -static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen); - -/* - LookupModule - lookup and return the ModuleChain pointer containing - module name from a particular list. -*/ - -static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname); - -/* - toCString - replace any character sequence - into a newline. -*/ - -static void toCString (char *str, unsigned int _str_high); - -/* - strcmp - return 0 if both strings are equal. - We cannot use Builtins.def during bootstrap. -*/ - -static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b); - -/* - strncmp - return 0 if both strings are equal. - We cannot use Builtins.def during bootstrap. -*/ - -static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n); - -/* - strlen - returns the length of string. -*/ - -static int strlen_ (M2LINK_PtrToChar string); - -/* - traceprintf - wrap printf with a boolean flag. -*/ - -static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high); - -/* - traceprintf2 - wrap printf with a boolean flag. -*/ - -static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg); - -/* - traceprintf3 - wrap printf with a boolean flag. -*/ - -static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2); - -/* - moveTo - moves mptr to the new list determined by newstate. - It updates the mptr state appropriately. -*/ - -static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr); - -/* - ResolveDependant - -*/ - -static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname); - -/* - PerformRequestDependant - the current modulename has a dependancy upon - dependantmodule. If dependantmodule is NIL then - modulename has no further dependants and it can be - resolved. -*/ - -static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname); - -/* - ResolveDependencies - resolve dependencies for currentmodule, libname. -*/ - -static void ResolveDependencies (void * currentmodule, void * libname); - -/* - DisplayModuleInfo - displays all module in the state. -*/ - -static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high); - -/* - DumpModuleData - -*/ - -static void DumpModuleData (unsigned int flag); - -/* - combine - dest := src + dest. Places src at the front of list dest. - Pre condition: src, dest are lists. - Post condition : dest := src + dest - src := NIL. -*/ - -static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest); - -/* - tracemodule - -*/ - -static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen); - -/* - ForceModule - -*/ - -static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen); - -/* - ForceDependencies - if the user has specified a forced order then we override - the dynamic ordering with the preference. -*/ - -static void ForceDependencies (void); - -/* - CheckApplication - check to see that the application is the last entry in the list. - This might happen if the application only imports FOR C modules. -*/ - -static void CheckApplication (void); - -/* - warning3 - write format arg1 arg2 to stderr. -*/ - -static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2); - -/* - equal - return TRUE if C string cstr is equal to str. -*/ - -static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high); - -/* - SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace, - DumpPostInit to FALSE. It checks the environment - GCC_M2LINK_RTFLAG which can contain - "all,module,hex,pre,post,dep,force". all turns them all on. - The flag meanings are as follows and flags the are in - execution order. - - module generate trace info as the modules are registered. - hex dump the modules ctor functions address in hex. - pre generate a list of all modules seen prior to having - their dependancies resolved. - dep display a trace as the modules are resolved. - post generate a list of all modules seen after having - their dependancies resolved dynamically. - force generate a list of all modules seen after having - their dependancies resolved and forced. -*/ - -static void SetupDebugFlags (void); - -/* - Init - initialize the debug flags and set all lists to NIL. -*/ - -static void Init (void); - -/* - CheckInitialized - checks to see if this module has been initialized - and if it has not it calls Init. We need this - approach as this module is called by module ctors - before we reach main. -*/ - -static void CheckInitialized (void); - - -/* - CreateModule - creates a new module entry and returns the - ModuleChain. -*/ - -static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies) -{ - M2Dependent_ModuleChain mptr; - void * p0; - void * p1; - - Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2)); - mptr->name = name; - mptr->libname = libname; - mptr->init = init; - mptr->fini = fini; - mptr->dependency.proc = dependencies; - mptr->dependency.state = M2Dependent_unregistered; - mptr->prev = NULL; - mptr->next = NULL; - if (HexTrace) - { - libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini); - libc_printf ((const char *) " dep: %p)", 10, dependencies); - } - return mptr; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - AppendModule - append chain to end of the list. -*/ - -static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain) -{ - if ((*head) == NULL) - { - (*head) = chain; - chain->prev = chain; - chain->next = chain; - } - else - { - chain->next = (*head); /* Add Item to the end of list. */ - chain->prev = (*head)->prev; /* Add Item to the end of list. */ - (*head)->prev->next = chain; - (*head)->prev = chain; - } -} - - -/* - RemoveModule - remove chain from double linked list head. -*/ - -static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain) -{ - if ((chain->next == (*head)) && (chain == (*head))) - { - (*head) = NULL; - } - else - { - if ((*head) == chain) - { - (*head) = (*head)->next; - } - chain->prev->next = chain->next; - chain->next->prev = chain->prev; - } -} - - -/* - onChain - returns TRUE if mptr is on the Modules[state] list. -*/ - -static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr) -{ - M2Dependent_ModuleChain ptr; - - if (Modules.array[state-M2Dependent_unregistered] != NULL) - { - ptr = Modules.array[state-M2Dependent_unregistered]; - do { - if (ptr == mptr) - { - return TRUE; - } - ptr = ptr->next; - } while (! (ptr == Modules.array[state-M2Dependent_unregistered])); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - max - -*/ - -static unsigned int max (unsigned int a, unsigned int b) -{ - if (a > b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - min - -*/ - -static unsigned int min (unsigned int a, unsigned int b) -{ - if (a < b) - { - return a; - } - else - { - return b; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - LookupModuleN - lookup module from the state list. - The strings lengths are known. -*/ - -static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen) -{ - M2Dependent_ModuleChain ptr; - - if (Modules.array[state-M2Dependent_unregistered] != NULL) - { - ptr = Modules.array[state-M2Dependent_unregistered]; - do { - if (((strncmp (reinterpret_cast (ptr->name), reinterpret_cast (name), max (namelen, static_cast (strlen_ (reinterpret_cast (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast (ptr->libname), reinterpret_cast (libname), max (libnamelen, static_cast (strlen_ (reinterpret_cast (ptr->libname)))))) == 0)) - { - return ptr; - } - ptr = ptr->next; - } while (! (ptr == Modules.array[state-M2Dependent_unregistered])); - } - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - LookupModule - lookup and return the ModuleChain pointer containing - module name from a particular list. -*/ - -static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname) -{ - return LookupModuleN (state, name, static_cast (strlen_ (reinterpret_cast (name))), libname, static_cast (strlen_ (reinterpret_cast (libname)))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - toCString - replace any character sequence - into a newline. -*/ - -static void toCString (char *str, unsigned int _str_high) -{ - unsigned int high; - unsigned int i; - unsigned int j; - - i = 0; - high = _str_high; - while (i < high) - { - if ((i < high) && (str[i] == '\\')) - { - if (str[i+1] == 'n') - { - str[i] = ASCII_nl; - j = i+1; - while (j < high) - { - str[j] = str[j+1]; - j += 1; - } - } - } - i += 1; - } -} - - -/* - strcmp - return 0 if both strings are equal. - We cannot use Builtins.def during bootstrap. -*/ - -static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b) -{ - if ((a != NULL) && (b != NULL)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (a == b) - { - return 0; - } - else - { - while ((*a) == (*b)) - { - if ((*a) == ASCII_nul) - { - return 0; - } - a += 1; - b += 1; - } - } - } - return 1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - strncmp - return 0 if both strings are equal. - We cannot use Builtins.def during bootstrap. -*/ - -static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n) -{ - if (n == 0) - { - return 0; - } - else if ((a != NULL) && (b != NULL)) - { - /* avoid dangling else. */ - if (a == b) - { - return 0; - } - else - { - while (((*a) == (*b)) && (n > 0)) - { - if (((*a) == ASCII_nul) || (n == 1)) - { - return 0; - } - a += 1; - b += 1; - n -= 1; - } - } - } - return 1; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - strlen - returns the length of string. -*/ - -static int strlen_ (M2LINK_PtrToChar string) -{ - int count; - - if (string == NULL) - { - return 0; - } - else - { - count = 0; - while ((*string) != ASCII_nul) - { - string += 1; - count += 1; - } - return count; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - traceprintf - wrap printf with a boolean flag. -*/ - -static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high) -{ - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - if (flag) - { - toCString ((char *) str, _str_high); - libc_printf ((const char *) str, _str_high); - } -} - - -/* - traceprintf2 - wrap printf with a boolean flag. -*/ - -static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg) -{ - char ch; - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - if (flag) - { - toCString ((char *) str, _str_high); - if (arg == NULL) - { - ch = (char) 0; - arg = &ch; - } - libc_printf ((const char *) str, _str_high, arg); - } -} - - -/* - traceprintf3 - wrap printf with a boolean flag. -*/ - -static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2) -{ - char ch; - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - if (flag) - { - toCString ((char *) str, _str_high); - if (arg1 == NULL) - { - ch = (char) 0; - arg1 = &ch; - } - if (arg2 == NULL) - { - ch = (char) 0; - arg2 = &ch; - } - libc_printf ((const char *) str, _str_high, arg1, arg2); - } -} - - -/* - moveTo - moves mptr to the new list determined by newstate. - It updates the mptr state appropriately. -*/ - -static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr) -{ - if (onChain (mptr->dependency.state, mptr)) - { - RemoveModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr); - } - mptr->dependency.state = newstate; - AppendModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr); -} - - -/* - ResolveDependant - -*/ - -static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname) -{ - if (mptr == NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname); - } - else - { - if (onChain (M2Dependent_started, mptr)) - { - traceprintf (DependencyTrace, (const char *) " processing...\\n", 18); - } - else - { - moveTo (M2Dependent_started, mptr); - traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname); - (*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */ - traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */ - moveTo (M2Dependent_ordered, mptr); - } - } -} - - -/* - PerformRequestDependant - the current modulename has a dependancy upon - dependantmodule. If dependantmodule is NIL then - modulename has no further dependants and it can be - resolved. -*/ - -static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname) -{ - M2Dependent_ModuleChain mptr; - - traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname); - if (dependantmodule == NULL) - { - /* avoid dangling else. */ - traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32); - mptr = LookupModule (M2Dependent_unordered, modulename, libname); - if (mptr != NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname); - moveTo (M2Dependent_ordered, mptr); - } - } - else - { - traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname); - mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname); - if (mptr == NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname); - mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname); - if (mptr == NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname); - mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname); - if (mptr == NULL) - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname); - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname); - traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname); - } - else - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname); - } - } - else - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname); - ResolveDependant (mptr, dependantmodule, dependantlibname); - } - } - else - { - traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname); - traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname); - } - } -} - - -/* - ResolveDependencies - resolve dependencies for currentmodule, libname. -*/ - -static void ResolveDependencies (void * currentmodule, void * libname) -{ - M2Dependent_ModuleChain mptr; - - mptr = LookupModule (M2Dependent_unordered, currentmodule, libname); - while (mptr != NULL) - { - traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname); - ResolveDependant (mptr, currentmodule, libname); - mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered]; - } -} - - -/* - DisplayModuleInfo - displays all module in the state. -*/ - -static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high) -{ - M2Dependent_ModuleChain mptr; - unsigned int count; - char desc[_desc_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (desc, desc_, _desc_high+1); - - if (Modules.array[state-M2Dependent_unregistered] != NULL) - { - libc_printf ((const char *) "%s modules\\n", 12, &desc); - mptr = Modules.array[state-M2Dependent_unregistered]; - count = 0; - do { - if (mptr->name == NULL) - { - libc_printf ((const char *) " %d %s []", 11, count, mptr->name); - } - else - { - libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname); - } - count += 1; - if (mptr->dependency.appl) - { - libc_printf ((const char *) " application", 12); - } - if (mptr->dependency.forc) - { - libc_printf ((const char *) " for C", 6); - } - if (mptr->dependency.forced) - { - libc_printf ((const char *) " forced ordering", 16); - } - libc_printf ((const char *) "\\n", 2); - mptr = mptr->next; - } while (! (mptr == Modules.array[state-M2Dependent_unregistered])); - } -} - - -/* - DumpModuleData - -*/ - -static void DumpModuleData (unsigned int flag) -{ - M2Dependent_ModuleChain mptr; - - if (flag) - { - DisplayModuleInfo (M2Dependent_unregistered, (const char *) "unregistered", 12); - DisplayModuleInfo (M2Dependent_unordered, (const char *) "unordered", 9); - DisplayModuleInfo (M2Dependent_started, (const char *) "started", 7); - DisplayModuleInfo (M2Dependent_ordered, (const char *) "ordered", 7); - } -} - - -/* - combine - dest := src + dest. Places src at the front of list dest. - Pre condition: src, dest are lists. - Post condition : dest := src + dest - src := NIL. -*/ - -static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest) -{ - M2Dependent_ModuleChain last; - - while (Modules.array[src-M2Dependent_unregistered] != NULL) - { - last = Modules.array[src-M2Dependent_unregistered]->prev; - moveTo (M2Dependent_ordered, last); - Modules.array[dest-M2Dependent_unregistered] = last; /* New item is at the head. */ - } -} - - -/* - tracemodule - -*/ - -static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen) -{ - typedef struct tracemodule__T4_a tracemodule__T4; - - struct tracemodule__T4_a { char array[100+1]; }; - tracemodule__T4 buffer; - unsigned int len; - - if (flag) - { - len = min (modlen, sizeof (buffer)-1); - libc_strncpy (&buffer, modname, len); - buffer.array[len] = (char) 0; - libc_printf ((const char *) "%s ", 3, &buffer); - len = min (liblen, sizeof (buffer)-1); - libc_strncpy (&buffer, libname, len); - buffer.array[len] = (char) 0; - libc_printf ((const char *) " [%s]", 5, &buffer); - } -} - - -/* - ForceModule - -*/ - -static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen) -{ - M2Dependent_ModuleChain mptr; - - traceprintf (ForceTrace, (const char *) "forcing module: ", 16); - tracemodule (ForceTrace, modname, modlen, libname, liblen); - traceprintf (ForceTrace, (const char *) "\\n", 2); - mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen); - if (mptr != NULL) - { - mptr->dependency.forced = TRUE; - moveTo (M2Dependent_user, mptr); - } -} - - -/* - ForceDependencies - if the user has specified a forced order then we override - the dynamic ordering with the preference. -*/ - -static void ForceDependencies (void) -{ - unsigned int len; - unsigned int modlen; - unsigned int liblen; - M2LINK_PtrToChar modname; - M2LINK_PtrToChar libname; - M2LINK_PtrToChar pc; - M2LINK_PtrToChar start; - - if (M2LINK_ForcedModuleInitOrder != NULL) - { - traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast (M2LINK_ForcedModuleInitOrder)); - pc = M2LINK_ForcedModuleInitOrder; - start = pc; - len = 0; - modname = NULL; - modlen = 0; - libname = NULL; - liblen = 0; - while ((*pc) != ASCII_nul) - { - switch ((*pc)) - { - case ':': - libname = start; - liblen = len; - len = 0; - pc += 1; - start = pc; - break; - - case ',': - modname = start; - modlen = len; - ForceModule (reinterpret_cast (modname), modlen, reinterpret_cast (libname), liblen); - libname = NULL; - liblen = 0; - modlen = 0; - len = 0; - pc += 1; - start = pc; - break; - - - default: - pc += 1; - len += 1; - break; - } - } - if (start != pc) - { - ForceModule (reinterpret_cast (start), len, reinterpret_cast (libname), liblen); - } - combine (M2Dependent_user, M2Dependent_ordered); - } -} - - -/* - CheckApplication - check to see that the application is the last entry in the list. - This might happen if the application only imports FOR C modules. -*/ - -static void CheckApplication (void) -{ - M2Dependent_ModuleChain mptr; - M2Dependent_ModuleChain appl; - - mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]; - if (mptr != NULL) - { - appl = NULL; - do { - if (mptr->dependency.appl) - { - appl = mptr; - } - else - { - mptr = mptr->next; - } - } while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]))); - if (appl != NULL) - { - RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl); - AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl); - } - } -} - - -/* - warning3 - write format arg1 arg2 to stderr. -*/ - -static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2) -{ - typedef struct warning3__T5_a warning3__T5; - - struct warning3__T5_a { char array[4096+1]; }; - warning3__T5 buffer; - int len; - char format[_format_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (format, format_, _format_high+1); - - if (WarningTrace) - { - len = libc_snprintf (&buffer, static_cast (sizeof (buffer)), (const char *) "warning: ", 9); - libc_write (2, &buffer, static_cast (len)); - len = libc_snprintf (&buffer, static_cast (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2); - libc_write (2, &buffer, static_cast (len)); - } -} - - -/* - equal - return TRUE if C string cstr is equal to str. -*/ - -static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high) -{ - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - return (strncmp (reinterpret_cast (cstr), reinterpret_cast (&str), StrLib_StrLen ((const char *) str, _str_high))) == 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace, - DumpPostInit to FALSE. It checks the environment - GCC_M2LINK_RTFLAG which can contain - "all,module,hex,pre,post,dep,force". all turns them all on. - The flag meanings are as follows and flags the are in - execution order. - - module generate trace info as the modules are registered. - hex dump the modules ctor functions address in hex. - pre generate a list of all modules seen prior to having - their dependancies resolved. - dep display a trace as the modules are resolved. - post generate a list of all modules seen after having - their dependancies resolved dynamically. - force generate a list of all modules seen after having - their dependancies resolved and forced. -*/ - -static void SetupDebugFlags (void) -{ - typedef char *SetupDebugFlags__T1; - - SetupDebugFlags__T1 pc; - - ModuleTrace = FALSE; - DependencyTrace = FALSE; - PostTrace = FALSE; - PreTrace = FALSE; - ForceTrace = FALSE; - HexTrace = FALSE; - WarningTrace = FALSE; - pc = static_cast (libc_getenv (const_cast (reinterpret_cast("GCC_M2LINK_RTFLAG")))); - while ((pc != NULL) && ((*pc) != ASCII_nul)) - { - if (equal (reinterpret_cast (pc), (const char *) "all", 3)) - { - ModuleTrace = TRUE; - DependencyTrace = TRUE; - PreTrace = TRUE; - PostTrace = TRUE; - ForceTrace = TRUE; - HexTrace = TRUE; - WarningTrace = TRUE; - pc += 3; - } - else if (equal (reinterpret_cast (pc), (const char *) "module", 6)) - { - /* avoid dangling else. */ - ModuleTrace = TRUE; - pc += 6; - } - else if (equal (reinterpret_cast (pc), (const char *) "warning", 7)) - { - /* avoid dangling else. */ - WarningTrace = TRUE; - pc += 7; - } - else if (equal (reinterpret_cast (pc), (const char *) "hex", 3)) - { - /* avoid dangling else. */ - HexTrace = TRUE; - pc += 3; - } - else if (equal (reinterpret_cast (pc), (const char *) "dep", 3)) - { - /* avoid dangling else. */ - DependencyTrace = TRUE; - pc += 3; - } - else if (equal (reinterpret_cast (pc), (const char *) "pre", 3)) - { - /* avoid dangling else. */ - PreTrace = TRUE; - pc += 3; - } - else if (equal (reinterpret_cast (pc), (const char *) "post", 4)) - { - /* avoid dangling else. */ - PostTrace = TRUE; - pc += 4; - } - else if (equal (reinterpret_cast (pc), (const char *) "force", 5)) - { - /* avoid dangling else. */ - ForceTrace = TRUE; - pc += 5; - } - else - { - /* avoid dangling else. */ - pc += 1; - } - } -} - - -/* - Init - initialize the debug flags and set all lists to NIL. -*/ - -static void Init (void) -{ - M2Dependent_DependencyState state; - - SetupDebugFlags (); - for (state=M2Dependent_unregistered; state<=M2Dependent_user; state= static_cast(static_cast(state+1))) - { - Modules.array[state-M2Dependent_unregistered] = NULL; - } -} - - -/* - CheckInitialized - checks to see if this module has been initialized - and if it has not it calls Init. We need this - approach as this module is called by module ctors - before we reach main. -*/ - -static void CheckInitialized (void) -{ - if (! Initialized) - { - Initialized = TRUE; - Init (); - } -} - - -/* - ConstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp) -{ - M2Dependent_ModuleChain mptr; - M2Dependent_ArgCVEnvP nulp; - - CheckInitialized (); - traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname); - mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname); - if (mptr != NULL) - { - mptr->dependency.appl = TRUE; - } - traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26); - DumpModuleData (PreTrace); - ResolveDependencies (applicationmodule, libname); - traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27); - DumpModuleData (PostTrace); - ForceDependencies (); - traceprintf (ForceTrace, (const char *) "After user forcing ordering\\n", 29); - DumpModuleData (ForceTrace); - CheckApplication (); - traceprintf (ForceTrace, (const char *) "After runtime forces application to the end\\n", 45); - DumpModuleData (ForceTrace); - if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL) - { - traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname); - traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule); - traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule); - } - else - { - mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]; - do { - if (mptr->dependency.forc) - { - traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname); - } - else - { - traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname); - } - if (mptr->dependency.appl) - { - traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname); - traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42); - M2RTS_ExecuteInitialProcedures (); - traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30); - } - (*mptr->init.proc) (argc, argv, envp); - mptr = mptr->next; - } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])); - } -} - - -/* - DeconstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp) -{ - M2Dependent_ModuleChain mptr; - - traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname); - if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL) - { - traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45); - } - else - { - traceprintf (ModuleTrace, (const char *) "ExecuteTerminationProcedures\\n", 30); - M2RTS_ExecuteTerminationProcedures (); - traceprintf (ModuleTrace, (const char *) "terminating modules in sequence\\n", 33); - mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev; - do { - if (mptr->dependency.forc) - { - traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname); - } - else - { - traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname); - } - (*mptr->fini.proc) (argc, argv, envp); - mptr = mptr->prev; - } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev)); - } -} - - -/* - RegisterModule - adds module name to the list of outstanding - modules which need to have their dependencies - explored to determine initialization order. -*/ - -extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies) -{ - M2Dependent_ModuleChain mptr; - - CheckInitialized (); - if (! M2LINK_StaticInitialization) - { - mptr = LookupModule (M2Dependent_unordered, modulename, libname); - if (mptr == NULL) - { - traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname); - moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies)); - traceprintf (ModuleTrace, (const char *) "\\n", 2); - } - else - { - warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname); - } - } -} - - -/* - RequestDependant - used to specify that modulename is dependant upon - module dependantmodule. It only takes effect - if we are not using StaticInitialization. -*/ - -extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname) -{ - CheckInitialized (); - if (! M2LINK_StaticInitialization) - { - PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname); - } -} - -extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - CheckInitialized (); -} - -extern "C" void _M2_M2Dependent_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GM2EXCEPTION.c b/gcc/m2/pge-boot/GM2EXCEPTION.c deleted file mode 100644 index cf19a4e18b7f..000000000000 --- a/gcc/m2/pge-boot/GM2EXCEPTION.c +++ /dev/null @@ -1,88 +0,0 @@ -/* do not edit automatically generated by mc from M2EXCEPTION. */ -/* M2EXCEPTION.mod implement M2Exception and IsM2Exception. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#include -# include "Gmcrts.h" -#define _M2EXCEPTION_H -#define _M2EXCEPTION_C - -# include "GSYSTEM.h" -# include "GRTExceptions.h" - -typedef enum {M2EXCEPTION_indexException, M2EXCEPTION_rangeException, M2EXCEPTION_caseSelectException, M2EXCEPTION_invalidLocation, M2EXCEPTION_functionException, M2EXCEPTION_wholeValueException, M2EXCEPTION_wholeDivException, M2EXCEPTION_realValueException, M2EXCEPTION_realDivException, M2EXCEPTION_complexValueException, M2EXCEPTION_complexDivException, M2EXCEPTION_protException, M2EXCEPTION_sysException, M2EXCEPTION_coException, M2EXCEPTION_exException} M2EXCEPTION_M2Exceptions; - -extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void); -extern "C" unsigned int M2EXCEPTION_IsM2Exception (void); - -extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void) -{ - RTExceptions_EHBlock e; - unsigned int n; - - /* If the program or coroutine is in the exception state then return the enumeration - value representing the exception cause. If it is not in the exception state then - raises and exception (exException). */ - e = RTExceptions_GetExceptionBlock (); - n = RTExceptions_GetNumber (e); - if (n == (UINT_MAX)) - { - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast (reinterpret_cast("M2Exception")), const_cast (reinterpret_cast("current coroutine is not in the exceptional execution state"))); - } - else - { - return (M2EXCEPTION_M2Exceptions) (n); - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1); - __builtin_unreachable (); -} - -extern "C" unsigned int M2EXCEPTION_IsM2Exception (void) -{ - RTExceptions_EHBlock e; - - /* Returns TRUE if the program or coroutine is in the exception state. - Returns FALSE if the program or coroutine is not in the exception state. */ - e = RTExceptions_GetExceptionBlock (); - return (RTExceptions_GetNumber (e)) != (UINT_MAX); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_M2EXCEPTION_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - RTExceptions_SetExceptionBlock (RTExceptions_InitExceptionBlock ()); -} - -extern "C" void _M2_M2EXCEPTION_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GM2LINK.c b/gcc/m2/pge-boot/GM2LINK.c deleted file mode 100644 index a934d6ada1cc..000000000000 --- a/gcc/m2/pge-boot/GM2LINK.c +++ /dev/null @@ -1,27 +0,0 @@ -/* GM2LINK.c a handwritten module for mc. - -Copyright (C) 2022-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -/* mc currently is built using a static scaffold. */ - -#include - -int M2LINK_StaticInitialization = 1; -char *M2LINK_ForcedModuleInitOrder = NULL; diff --git a/gcc/m2/pge-boot/GM2RTS.c b/gcc/m2/pge-boot/GM2RTS.c deleted file mode 100644 index d283f3f7f793..000000000000 --- a/gcc/m2/pge-boot/GM2RTS.c +++ /dev/null @@ -1,822 +0,0 @@ -/* do not edit automatically generated by mc from M2RTS. */ -/* M2RTS.mod Implements the run time system facilities of Modula-2. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -#include -# include "GStorage.h" -#include -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _M2RTS_H -#define _M2RTS_C - -# include "Glibc.h" -# include "GNumberIO.h" -# include "GStrLib.h" -# include "GSYSTEM.h" -# include "GASCII.h" -# include "GStorage.h" -# include "GRTExceptions.h" -# include "GM2EXCEPTION.h" -# include "GM2Dependent.h" - -typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP; - -# define stderrFd 2 -typedef struct M2RTS_ProcedureList_r M2RTS_ProcedureList; - -typedef char *M2RTS_PtrToChar; - -typedef struct M2RTS__T1_r M2RTS__T1; - -typedef M2RTS__T1 *M2RTS_ProcedureChain; - -typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *); -struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; }; - -struct M2RTS_ProcedureList_r { - M2RTS_ProcedureChain head; - M2RTS_ProcedureChain tail; - }; - -struct M2RTS__T1_r { - PROC p; - M2RTS_ProcedureChain prev; - M2RTS_ProcedureChain next; - }; - -static M2RTS_ProcedureList InitialProc; -static M2RTS_ProcedureList TerminateProc; -static int ExitValue; -static unsigned int isHalting; -static unsigned int CallExit; -static unsigned int Initialized; - -/* - ConstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); - -/* - DeconstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp); - -/* - RegisterModule - adds module name to the list of outstanding - modules which need to have their dependencies - explored to determine initialization order. -*/ - -extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies); - -/* - RequestDependant - used to specify that modulename is dependant upon - module dependantmodule. -*/ - -extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname); - -/* - InstallTerminationProcedure - installs a procedure, p, which will - be called when the procedure - ExecuteTerminationProcedures - is invoked. It returns TRUE if the - procedure is installed. -*/ - -extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p); - -/* - ExecuteInitialProcedures - executes the initial procedures installed by - InstallInitialProcedure. -*/ - -extern "C" void M2RTS_ExecuteInitialProcedures (void); - -/* - InstallInitialProcedure - installs a procedure to be executed just - before the BEGIN code section of the - main program module. -*/ - -extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p); - -/* - ExecuteTerminationProcedures - calls each installed termination procedure - in reverse order. -*/ - -extern "C" void M2RTS_ExecuteTerminationProcedures (void); - -/* - Terminate - provides compatibility for pim. It calls exit with - the exitcode provided in a prior call to ExitOnHalt - (or zero if ExitOnHalt was never called). It does - not call ExecuteTerminationProcedures. -*/ - -extern "C" void M2RTS_Terminate (void); - -/* - HALT - terminate the current program. The procedure - ExecuteTerminationProcedures - is called before the program is stopped. The parameter - exitcode is optional. If the parameter is not supplied - HALT will call libc 'abort', otherwise it will exit with - the code supplied. Supplying a parameter to HALT has the - same effect as calling ExitOnHalt with the same code and - then calling HALT with no parameter. -*/ - -extern "C" void M2RTS_HALT (int exitcode); - -/* - Halt - provides a more user friendly version of HALT, which takes - four parameters to aid debugging. It writes an error message - to stderr and calls exit (1). -*/ - -extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high); - -/* - HaltC - provides a more user friendly version of HALT, which takes - four parameters to aid debugging. It writes an error message - to stderr and calls exit (1). -*/ - -extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description); - -/* - ExitOnHalt - if HALT is executed then call exit with the exit code, e. -*/ - -extern "C" void M2RTS_ExitOnHalt (int e); - -/* - ErrorMessage - emits an error message to stderr and then calls exit (1). -*/ - -extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high); - -/* - Length - returns the length of a string, a. This is called whenever - the user calls LENGTH and the parameter cannot be calculated - at compile time. -*/ - -extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high); -extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); -extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message); - -/* - ExecuteReverse - execute the procedure associated with procptr - and then proceed to try and execute all previous - procedures in the chain. -*/ - -static void ExecuteReverse (M2RTS_ProcedureChain procptr); - -/* - AppendProc - append proc to the end of the procedure list - defined by proclist. -*/ - -static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc); - -/* - ErrorString - writes a string to stderr. -*/ - -static void ErrorString (const char *a_, unsigned int _a_high); - -/* - ErrorStringC - writes a string to stderr. -*/ - -static void ErrorStringC (void * str); - -/* - ErrorMessageC - emits an error message to stderr and then calls exit (1). -*/ - -static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function); - -/* - InitProcList - initialize the head and tail pointers to NIL. -*/ - -static void InitProcList (M2RTS_ProcedureList *p); - -/* - Init - initialize the initial, terminate procedure lists and booleans. -*/ - -static void Init (void); - -/* - CheckInitialized - checks to see if this module has been initialized - and if it has not it calls Init. We need this - approach as this module is called by module ctors - before we reach main. -*/ - -static void CheckInitialized (void); - - -/* - ExecuteReverse - execute the procedure associated with procptr - and then proceed to try and execute all previous - procedures in the chain. -*/ - -static void ExecuteReverse (M2RTS_ProcedureChain procptr) -{ - while (procptr != NULL) - { - (*procptr->p.proc) (); /* Invoke the procedure. */ - procptr = procptr->prev; /* Invoke the procedure. */ - } -} - - -/* - AppendProc - append proc to the end of the procedure list - defined by proclist. -*/ - -static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc) -{ - M2RTS_ProcedureChain pdes; - - Storage_ALLOCATE ((void **) &pdes, sizeof (M2RTS__T1)); - pdes->p = proc; - pdes->prev = (*proclist).tail; - pdes->next = NULL; - if ((*proclist).head == NULL) - { - (*proclist).head = pdes; - } - (*proclist).tail = pdes; - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ErrorString - writes a string to stderr. -*/ - -static void ErrorString (const char *a_, unsigned int _a_high) -{ - int n; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - n = static_cast (libc_write (stderrFd, &a, static_cast (StrLib_StrLen ((const char *) a, _a_high)))); -} - - -/* - ErrorStringC - writes a string to stderr. -*/ - -static void ErrorStringC (void * str) -{ - int len; - - len = static_cast (libc_write (stderrFd, str, libc_strlen (str))); -} - - -/* - ErrorMessageC - emits an error message to stderr and then calls exit (1). -*/ - -static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function) -{ - typedef struct ErrorMessageC__T2_a ErrorMessageC__T2; - - struct ErrorMessageC__T2_a { char array[10+1]; }; - ErrorMessageC__T2 buffer; - - ErrorStringC (filename); - ErrorString ((const char *) ":", 1); - NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10); - ErrorString ((const char *) &buffer.array[0], 10); - ErrorString ((const char *) ":", 1); - if ((libc_strlen (function)) > 0) - { - ErrorString ((const char *) "in ", 3); - ErrorStringC (function); - ErrorString ((const char *) " has caused ", 12); - } - ErrorStringC (message); - buffer.array[0] = ASCII_nl; - buffer.array[1] = ASCII_nul; - ErrorString ((const char *) &buffer.array[0], 10); - libc_exit (1); -} - - -/* - InitProcList - initialize the head and tail pointers to NIL. -*/ - -static void InitProcList (M2RTS_ProcedureList *p) -{ - (*p).head = NULL; - (*p).tail = NULL; -} - - -/* - Init - initialize the initial, terminate procedure lists and booleans. -*/ - -static void Init (void) -{ - InitProcList (&InitialProc); - InitProcList (&TerminateProc); - ExitValue = 0; - isHalting = FALSE; - CallExit = FALSE; /* default by calling abort */ -} - - -/* - CheckInitialized - checks to see if this module has been initialized - and if it has not it calls Init. We need this - approach as this module is called by module ctors - before we reach main. -*/ - -static void CheckInitialized (void) -{ - if (! Initialized) - { - Initialized = TRUE; - Init (); - } -} - - -/* - ConstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp) -{ - M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp); -} - - -/* - DeconstructModules - resolve dependencies and then call each - module constructor in turn. -*/ - -extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp) -{ - M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp); -} - - -/* - RegisterModule - adds module name to the list of outstanding - modules which need to have their dependencies - explored to determine initialization order. -*/ - -extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies) -{ - M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies); -} - - -/* - RequestDependant - used to specify that modulename is dependant upon - module dependantmodule. -*/ - -extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname) -{ - M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname); -} - - -/* - InstallTerminationProcedure - installs a procedure, p, which will - be called when the procedure - ExecuteTerminationProcedures - is invoked. It returns TRUE if the - procedure is installed. -*/ - -extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p) -{ - return AppendProc (&TerminateProc, p); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ExecuteInitialProcedures - executes the initial procedures installed by - InstallInitialProcedure. -*/ - -extern "C" void M2RTS_ExecuteInitialProcedures (void) -{ - ExecuteReverse (InitialProc.tail); -} - - -/* - InstallInitialProcedure - installs a procedure to be executed just - before the BEGIN code section of the - main program module. -*/ - -extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p) -{ - return AppendProc (&InitialProc, p); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ExecuteTerminationProcedures - calls each installed termination procedure - in reverse order. -*/ - -extern "C" void M2RTS_ExecuteTerminationProcedures (void) -{ - ExecuteReverse (TerminateProc.tail); -} - - -/* - Terminate - provides compatibility for pim. It calls exit with - the exitcode provided in a prior call to ExitOnHalt - (or zero if ExitOnHalt was never called). It does - not call ExecuteTerminationProcedures. -*/ - -extern "C" void M2RTS_Terminate (void) -{ - libc_exit (ExitValue); -} - - -/* - HALT - terminate the current program. The procedure - ExecuteTerminationProcedures - is called before the program is stopped. The parameter - exitcode is optional. If the parameter is not supplied - HALT will call libc 'abort', otherwise it will exit with - the code supplied. Supplying a parameter to HALT has the - same effect as calling ExitOnHalt with the same code and - then calling HALT with no parameter. -*/ - -extern "C" void M2RTS_HALT (int exitcode) -{ - if (exitcode != -1) - { - CallExit = TRUE; - ExitValue = exitcode; - } - if (isHalting) - { - /* double HALT found */ - libc_exit (-1); - } - else - { - isHalting = TRUE; - M2RTS_ExecuteTerminationProcedures (); - } - if (CallExit) - { - libc_exit (ExitValue); - } - else - { - libc_abort (); - } -} - - -/* - Halt - provides a more user friendly version of HALT, which takes - four parameters to aid debugging. It writes an error message - to stderr and calls exit (1). -*/ - -extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) -{ - char filename[_filename_high+1]; - char function[_function_high+1]; - char description[_description_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (filename, filename_, _filename_high+1); - memcpy (function, function_, _function_high+1); - memcpy (description, description_, _description_high+1); - - M2RTS_ErrorMessage ((const char *) description, _description_high, (const char *) filename, _filename_high, line, (const char *) function, _function_high); -} - - -/* - HaltC - provides a more user friendly version of HALT, which takes - four parameters to aid debugging. It writes an error message - to stderr and calls exit (1). -*/ - -extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) -{ - ErrorMessageC (description, filename, line, function); -} - - -/* - ExitOnHalt - if HALT is executed then call exit with the exit code, e. -*/ - -extern "C" void M2RTS_ExitOnHalt (int e) -{ - ExitValue = e; - CallExit = TRUE; -} - - -/* - ErrorMessage - emits an error message to stderr and then calls exit (1). -*/ - -extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) -{ - typedef struct ErrorMessage__T3_a ErrorMessage__T3; - - struct ErrorMessage__T3_a { char array[10+1]; }; - ErrorMessage__T3 buffer; - char message[_message_high+1]; - char filename[_filename_high+1]; - char function[_function_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (message, message_, _message_high+1); - memcpy (filename, filename_, _filename_high+1); - memcpy (function, function_, _function_high+1); - - ErrorString ((const char *) filename, _filename_high); - ErrorString ((const char *) ":", 1); - NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10); - ErrorString ((const char *) &buffer.array[0], 10); - ErrorString ((const char *) ":", 1); - if (! (StrLib_StrEqual ((const char *) function, _function_high, (const char *) "", 0))) - { - ErrorString ((const char *) "in ", 3); - ErrorString ((const char *) function, _function_high); - ErrorString ((const char *) " has caused ", 12); - } - ErrorString ((const char *) message, _message_high); - buffer.array[0] = ASCII_nl; - buffer.array[1] = ASCII_nul; - ErrorString ((const char *) &buffer.array[0], 10); - libc_exit (1); -} - - -/* - Length - returns the length of a string, a. This is called whenever - the user calls LENGTH and the parameter cannot be calculated - at compile time. -*/ - -extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high) -{ - unsigned int l; - unsigned int h; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - l = 0; - h = _a_high; - while ((l <= h) && (a[l] != ASCII_nul)) - { - l += 1; - } - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - /* - The following are the runtime exception handler routines. - */ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message); -} - -extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), filename, line, column, scope, message); -} - -extern "C" void _M2_M2RTS_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - CheckInitialized (); -} - -extern "C" void _M2_M2RTS_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GNameKey.c b/gcc/m2/pge-boot/GNameKey.c deleted file mode 100644 index ff8621f959d4..000000000000 --- a/gcc/m2/pge-boot/GNameKey.c +++ /dev/null @@ -1,612 +0,0 @@ -/* do not edit automatically generated by mc from NameKey. */ -/* NameKey.mod provides a dynamic binary tree name to key. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _NameKey_H -#define _NameKey_C - -# include "GSYSTEM.h" -# include "GStorage.h" -# include "GIndexing.h" -# include "GStrIO.h" -# include "GStdIO.h" -# include "GNumberIO.h" -# include "GStrLib.h" -# include "Glibc.h" -# include "GASCII.h" -# include "GM2RTS.h" - -# define NameKey_NulName 0 -typedef unsigned int NameKey_Name; - -typedef struct NameKey_Node_r NameKey_Node; - -typedef char *NameKey_PtrToChar; - -typedef NameKey_Node *NameKey_NameNode; - -typedef enum {NameKey_less, NameKey_equal, NameKey_greater} NameKey_Comparison; - -struct NameKey_Node_r { - NameKey_PtrToChar Data; - NameKey_Name Key; - NameKey_NameNode Left; - NameKey_NameNode Right; - }; - -static NameKey_NameNode BinaryTree; -static Indexing_Index KeyIndex; -static unsigned int LastIndice; - -/* - MakeKey - returns the Key of the symbol, a. If a is not in the - name table then it is added, otherwise the Key of a is returned - directly. Note that the name table has no scope - it merely - presents a more convienient way of expressing strings. By a Key. -*/ - -extern "C" NameKey_Name NameKey_MakeKey (const char *a_, unsigned int _a_high); - -/* - makekey - returns the Key of the symbol, a. If a is not in the - name table then it is added, otherwise the Key of a is returned - directly. Note that the name table has no scope - it merely - presents a more convienient way of expressing strings. By a Key. - These keys last for the duration of compilation. -*/ - -extern "C" NameKey_Name NameKey_makekey (void * a); - -/* - GetKey - returns the name, a, of the key, Key. -*/ - -extern "C" void NameKey_GetKey (NameKey_Name key, char *a, unsigned int _a_high); - -/* - LengthKey - returns the StrLen of Key. -*/ - -extern "C" unsigned int NameKey_LengthKey (NameKey_Name Key); - -/* - IsKey - returns TRUE if string, a, is currently a key. - We dont use the Compare function, we inline it and avoid - converting, a, into a String, for speed. -*/ - -extern "C" unsigned int NameKey_IsKey (const char *a_, unsigned int _a_high); - -/* - KeyToCharStar - returns the C char * string equivalent for, key. -*/ - -extern "C" void NameKey_WriteKey (NameKey_Name key); - -/* - IsSameExcludingCase - returns TRUE if key1 and key2 are - the same. It is case insensitive. - This function deliberately inlines CAP for speed. -*/ - -extern "C" unsigned int NameKey_IsSameExcludingCase (NameKey_Name key1, NameKey_Name key2); - -/* - KeyToCharStar - returns the C char * string equivalent for, key. -*/ - -extern "C" void * NameKey_KeyToCharStar (NameKey_Name key); - -/* - CharKey - returns the key[i] character. -*/ - -extern "C" char NameKey_CharKey (NameKey_Name key, unsigned int i); - -/* - DoMakeKey - finds the name, n, in the tree or else create a name. - If a name is found then the string, n, is deallocated. -*/ - -static NameKey_Name DoMakeKey (NameKey_PtrToChar n, unsigned int higha); - -/* - Compare - return the result of Names[i] with Names[j] -*/ - -static NameKey_Comparison Compare (NameKey_PtrToChar pi, NameKey_Name j); - -/* - FindNodeAndParentInTree - search BinaryTree for a name. - If this name is found in the BinaryTree then - child is set to this name and father is set to the node above. - A comparison is returned to assist adding entries into this tree. -*/ - -static NameKey_Comparison FindNodeAndParentInTree (NameKey_PtrToChar n, NameKey_NameNode *child, NameKey_NameNode *father); - - -/* - DoMakeKey - finds the name, n, in the tree or else create a name. - If a name is found then the string, n, is deallocated. -*/ - -static NameKey_Name DoMakeKey (NameKey_PtrToChar n, unsigned int higha) -{ - NameKey_Comparison result; - NameKey_NameNode father; - NameKey_NameNode child; - NameKey_Name k; - - result = FindNodeAndParentInTree (n, &child, &father); - if (child == NULL) - { - if (result == NameKey_less) - { - Storage_ALLOCATE ((void **) &child, sizeof (NameKey_Node)); - father->Left = child; - } - else if (result == NameKey_greater) - { - /* avoid dangling else. */ - Storage_ALLOCATE ((void **) &child, sizeof (NameKey_Node)); - father->Right = child; - } - child->Right = NULL; - child->Left = NULL; - LastIndice += 1; - child->Key = LastIndice; - child->Data = n; - Indexing_PutIndice (KeyIndex, child->Key, reinterpret_cast (n)); - k = LastIndice; - } - else - { - Storage_DEALLOCATE (reinterpret_cast (&n), higha+1); - k = child->Key; - } - return k; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Compare - return the result of Names[i] with Names[j] -*/ - -static NameKey_Comparison Compare (NameKey_PtrToChar pi, NameKey_Name j) -{ - NameKey_PtrToChar pj; - char c1; - char c2; - - pj = static_cast (NameKey_KeyToCharStar (j)); - c1 = (*pi); - c2 = (*pj); - while ((c1 != ASCII_nul) || (c2 != ASCII_nul)) - { - if (c1 < c2) - { - return NameKey_less; - } - else if (c1 > c2) - { - /* avoid dangling else. */ - return NameKey_greater; - } - else - { - /* avoid dangling else. */ - pi += 1; - pj += 1; - c1 = (*pi); - c2 = (*pj); - } - } - return NameKey_equal; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FindNodeAndParentInTree - search BinaryTree for a name. - If this name is found in the BinaryTree then - child is set to this name and father is set to the node above. - A comparison is returned to assist adding entries into this tree. -*/ - -static NameKey_Comparison FindNodeAndParentInTree (NameKey_PtrToChar n, NameKey_NameNode *child, NameKey_NameNode *father) -{ - NameKey_Comparison result; - - /* firstly set up the initial values of child and father, using sentinal node */ - (*father) = BinaryTree; - (*child) = BinaryTree->Left; - if ((*child) == NULL) - { - return NameKey_less; - } - else - { - do { - result = Compare (n, (*child)->Key); - if (result == NameKey_less) - { - (*father) = (*child); - (*child) = (*child)->Left; - } - else if (result == NameKey_greater) - { - /* avoid dangling else. */ - (*father) = (*child); - (*child) = (*child)->Right; - } - } while (! (((*child) == NULL) || (result == NameKey_equal))); - return result; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - MakeKey - returns the Key of the symbol, a. If a is not in the - name table then it is added, otherwise the Key of a is returned - directly. Note that the name table has no scope - it merely - presents a more convienient way of expressing strings. By a Key. -*/ - -extern "C" NameKey_Name NameKey_MakeKey (const char *a_, unsigned int _a_high) -{ - NameKey_PtrToChar n; - NameKey_PtrToChar p; - unsigned int i; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - higha = StrLib_StrLen ((const char *) a, _a_high); - Storage_ALLOCATE (reinterpret_cast (&p), higha+1); - if (p == NULL) - { - M2RTS_HALT (-1); /* out of memory error */ - __builtin_unreachable (); - } - else - { - n = p; - i = 0; - while (i < higha) - { - (*p) = a[i]; - i += 1; - p += 1; - } - (*p) = ASCII_nul; - return DoMakeKey (n, higha); - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-compiler/NameKey.def", 20, 1); - __builtin_unreachable (); -} - - -/* - makekey - returns the Key of the symbol, a. If a is not in the - name table then it is added, otherwise the Key of a is returned - directly. Note that the name table has no scope - it merely - presents a more convienient way of expressing strings. By a Key. - These keys last for the duration of compilation. -*/ - -extern "C" NameKey_Name NameKey_makekey (void * a) -{ - NameKey_PtrToChar n; - NameKey_PtrToChar p; - NameKey_PtrToChar pa; - unsigned int i; - unsigned int higha; - - if (a == NULL) - { - return NameKey_NulName; - } - else - { - higha = static_cast (libc_strlen (a)); - Storage_ALLOCATE (reinterpret_cast (&p), higha+1); - if (p == NULL) - { - M2RTS_HALT (-1); /* out of memory error */ - __builtin_unreachable (); - } - else - { - n = p; - pa = static_cast (a); - i = 0; - while (i < higha) - { - (*p) = (*pa); - i += 1; - p += 1; - pa += 1; - } - (*p) = ASCII_nul; - return DoMakeKey (n, higha); - } - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-compiler/NameKey.def", 20, 1); - __builtin_unreachable (); -} - - -/* - GetKey - returns the name, a, of the key, Key. -*/ - -extern "C" void NameKey_GetKey (NameKey_Name key, char *a, unsigned int _a_high) -{ - NameKey_PtrToChar p; - unsigned int i; - unsigned int higha; - - p = static_cast (NameKey_KeyToCharStar (key)); - i = 0; - higha = _a_high; - while (((p != NULL) && (i <= higha)) && ((*p) != ASCII_nul)) - { - a[i] = (*p); - p += 1; - i += 1; - } - if (i <= higha) - { - a[i] = ASCII_nul; - } -} - - -/* - LengthKey - returns the StrLen of Key. -*/ - -extern "C" unsigned int NameKey_LengthKey (NameKey_Name Key) -{ - unsigned int i; - NameKey_PtrToChar p; - - p = static_cast (NameKey_KeyToCharStar (Key)); - i = 0; - while ((*p) != ASCII_nul) - { - i += 1; - p += 1; - } - return i; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsKey - returns TRUE if string, a, is currently a key. - We dont use the Compare function, we inline it and avoid - converting, a, into a String, for speed. -*/ - -extern "C" unsigned int NameKey_IsKey (const char *a_, unsigned int _a_high) -{ - NameKey_NameNode child; - NameKey_PtrToChar p; - unsigned int i; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - /* firstly set up the initial values of child, using sentinal node */ - child = BinaryTree->Left; - if (child != NULL) - { - do { - i = 0; - higha = _a_high; - p = static_cast (NameKey_KeyToCharStar (child->Key)); - while ((i <= higha) && (a[i] != ASCII_nul)) - { - if (a[i] < (*p)) - { - child = child->Left; - i = higha; - } - else if (a[i] > (*p)) - { - /* avoid dangling else. */ - child = child->Right; - i = higha; - } - else - { - /* avoid dangling else. */ - if ((a[i] == ASCII_nul) || (i == higha)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((*p) == ASCII_nul) - { - return TRUE; - } - else - { - child = child->Left; - } - } - p += 1; - } - i += 1; - } - } while (! (child == NULL)); - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KeyToCharStar - returns the C char * string equivalent for, key. -*/ - -extern "C" void NameKey_WriteKey (NameKey_Name key) -{ - NameKey_PtrToChar s; - - s = static_cast (NameKey_KeyToCharStar (key)); - while ((s != NULL) && ((*s) != ASCII_nul)) - { - StdIO_Write ((*s)); - s += 1; - } -} - - -/* - IsSameExcludingCase - returns TRUE if key1 and key2 are - the same. It is case insensitive. - This function deliberately inlines CAP for speed. -*/ - -extern "C" unsigned int NameKey_IsSameExcludingCase (NameKey_Name key1, NameKey_Name key2) -{ - NameKey_PtrToChar pi; - NameKey_PtrToChar pj; - char c1; - char c2; - - if (key1 == key2) - { - return TRUE; - } - else - { - pi = static_cast (NameKey_KeyToCharStar (key1)); - pj = static_cast (NameKey_KeyToCharStar (key2)); - c1 = (*pi); - c2 = (*pj); - while ((c1 != ASCII_nul) && (c2 != ASCII_nul)) - { - if (((c1 == c2) || (((c1 >= 'A') && (c1 <= 'Z')) && (c2 == ((char) (( ((unsigned int) (c1))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))))))) || (((c2 >= 'A') && (c2 <= 'Z')) && (c1 == ((char) (( ((unsigned int) (c2))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))))))) - { - pi += 1; - pj += 1; - c1 = (*pi); - c2 = (*pj); - } - else - { - /* difference found */ - return FALSE; - } - } - return c1 == c2; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KeyToCharStar - returns the C char * string equivalent for, key. -*/ - -extern "C" void * NameKey_KeyToCharStar (NameKey_Name key) -{ - if ((key == NameKey_NulName) || (! (Indexing_InBounds (KeyIndex, key)))) - { - return NULL; - } - else - { - return Indexing_GetIndice (KeyIndex, key); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CharKey - returns the key[i] character. -*/ - -extern "C" char NameKey_CharKey (NameKey_Name key, unsigned int i) -{ - NameKey_PtrToChar p; - - if (i >= (NameKey_LengthKey (key))) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - p = static_cast (NameKey_KeyToCharStar (key)); - p += i; - return (*p); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_NameKey_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - LastIndice = 0; - KeyIndex = Indexing_InitIndex (1); - Storage_ALLOCATE ((void **) &BinaryTree, sizeof (NameKey_Node)); - BinaryTree->Left = NULL; -} - -extern "C" void _M2_NameKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GNumberIO.c b/gcc/m2/pge-boot/GNumberIO.c deleted file mode 100644 index 0e058df5d647..000000000000 --- a/gcc/m2/pge-boot/GNumberIO.c +++ /dev/null @@ -1,777 +0,0 @@ -/* do not edit automatically generated by mc from NumberIO. */ -/* NumberIO.mod provides conversion of ordinal numbers. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -#define _NumberIO_H -#define _NumberIO_C - -# include "GASCII.h" -# include "GStrIO.h" -# include "GStrLib.h" -# include "GM2RTS.h" - -# define MaxLineLength 79 -# define MaxDigits 20 -# define MaxHexDigits 20 -# define MaxOctDigits 40 -# define MaxBits 64 -extern "C" void NumberIO_ReadCard (unsigned int *x); -extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n); -extern "C" void NumberIO_ReadHex (unsigned int *x); -extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n); -extern "C" void NumberIO_ReadInt (int *x); -extern "C" void NumberIO_WriteInt (int x, unsigned int n); -extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_ReadOct (unsigned int *x); -extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n); -extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_ReadBin (unsigned int *x); -extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n); -extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high); -extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x); -extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x); -extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x); - -extern "C" void NumberIO_ReadCard (unsigned int *x) -{ - typedef struct ReadCard__T1_a ReadCard__T1; - - struct ReadCard__T1_a { char array[MaxLineLength+1]; }; - ReadCard__T1 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToCard ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n) -{ - typedef struct WriteCard__T2_a WriteCard__T2; - - struct WriteCard__T2_a { char array[MaxLineLength+1]; }; - WriteCard__T2 a; - - NumberIO_CardToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_ReadHex (unsigned int *x) -{ - typedef struct ReadHex__T3_a ReadHex__T3; - - struct ReadHex__T3_a { char array[MaxLineLength+1]; }; - ReadHex__T3 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToHex ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n) -{ - typedef struct WriteHex__T4_a WriteHex__T4; - - struct WriteHex__T4_a { char array[MaxLineLength+1]; }; - WriteHex__T4 a; - - NumberIO_HexToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_ReadInt (int *x) -{ - typedef struct ReadInt__T5_a ReadInt__T5; - - struct ReadInt__T5_a { char array[MaxLineLength+1]; }; - ReadInt__T5 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToInt ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteInt (int x, unsigned int n) -{ - typedef struct WriteInt__T6_a WriteInt__T6; - - struct WriteInt__T6_a { char array[MaxLineLength+1]; }; - WriteInt__T6 a; - - NumberIO_IntToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct CardToStr__T7_a CardToStr__T7; - - struct CardToStr__T7_a { unsigned int array[MaxDigits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int Higha; - CardToStr__T7 buf; - - i = 0; - do { - i += 1; - if (i > MaxDigits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = x % 10; - x = x / 10; - } while (! (x == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = ' '; - j += 1; - n -= 1; - } - while ((i > 0) && (j <= Higha)) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if ((a[i] < '0') || (a[i] > '9')) - { - i += 1; - } - else - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - (*x) = (10*(*x))+( ((unsigned int) (a[i]))- ((unsigned int) ('0'))); - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if ((a[i] < '0') || (a[i] > '9')) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct HexToStr__T8_a HexToStr__T8; - - struct HexToStr__T8_a { unsigned int array[MaxHexDigits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int Higha; - HexToStr__T8 buf; - - i = 0; - do { - i += 1; - if (i > MaxHexDigits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = x % 0x010; - x = x / 0x010; - } while (! (x == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = '0'; - j += 1; - n -= 1; - } - while ((i != 0) && (j <= Higha)) - { - if (buf.array[i-1] < 10) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - } - else - { - a[j] = ((char) ((buf.array[i-1]+ ((unsigned int) ('A')))-10)); - } - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - NumberIO_StrToHexInt ((const char *) a, _a_high, &i); - (*x) = (unsigned int ) (i); -} - -extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct IntToStr__T9_a IntToStr__T9; - - struct IntToStr__T9_a { unsigned int array[MaxDigits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int c; - unsigned int Higha; - IntToStr__T9 buf; - unsigned int Negative; - - if (x < 0) - { - /* avoid dangling else. */ - Negative = TRUE; - c = ((unsigned int ) (abs (x+1)))+1; - if (n > 0) - { - n -= 1; - } - } - else - { - c = x; - Negative = FALSE; - } - i = 0; - do { - i += 1; - if (i > MaxDigits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = c % 10; - c = c / 10; - } while (! (c == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = ' '; - j += 1; - n -= 1; - } - if (Negative) - { - a[j] = '-'; - j += 1; - } - while ((i != 0) && (j <= Higha)) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int Negative; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - Negative = FALSE; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if (a[i] == '-') - { - i += 1; - Negative = ! Negative; - } - else if ((a[i] < '0') || (a[i] > '9')) - { - /* avoid dangling else. */ - i += 1; - } - else - { - /* avoid dangling else. */ - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - if (Negative) - { - (*x) = (10*(*x))-((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - } - else - { - (*x) = (10*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - } - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if ((a[i] < '0') || (a[i] > '9')) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void NumberIO_ReadOct (unsigned int *x) -{ - typedef struct ReadOct__T10_a ReadOct__T10; - - struct ReadOct__T10_a { char array[MaxLineLength+1]; }; - ReadOct__T10 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToOct ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n) -{ - typedef struct WriteOct__T11_a WriteOct__T11; - - struct WriteOct__T11_a { char array[MaxLineLength+1]; }; - WriteOct__T11 a; - - NumberIO_OctToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct OctToStr__T12_a OctToStr__T12; - - struct OctToStr__T12_a { unsigned int array[MaxOctDigits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int Higha; - OctToStr__T12 buf; - - i = 0; - do { - i += 1; - if (i > MaxOctDigits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = x % 8; - x = x / 8; - } while (! (x == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = ' '; - j += 1; - n -= 1; - } - while ((i > 0) && (j <= Higha)) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - NumberIO_StrToOctInt ((const char *) a, _a_high, &i); - (*x) = (unsigned int ) (i); -} - -extern "C" void NumberIO_ReadBin (unsigned int *x) -{ - typedef struct ReadBin__T13_a ReadBin__T13; - - struct ReadBin__T13_a { char array[MaxLineLength+1]; }; - ReadBin__T13 a; - - StrIO_ReadString ((char *) &a.array[0], MaxLineLength); - NumberIO_StrToBin ((const char *) &a.array[0], MaxLineLength, x); -} - -extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n) -{ - typedef struct WriteBin__T14_a WriteBin__T14; - - struct WriteBin__T14_a { char array[MaxLineLength+1]; }; - WriteBin__T14 a; - - NumberIO_BinToStr (x, n, (char *) &a.array[0], MaxLineLength); - StrIO_WriteString ((const char *) &a.array[0], MaxLineLength); -} - -extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high) -{ - typedef struct BinToStr__T15_a BinToStr__T15; - - struct BinToStr__T15_a { unsigned int array[MaxBits-1+1]; }; - unsigned int i; - unsigned int j; - unsigned int Higha; - BinToStr__T15 buf; - - i = 0; - do { - i += 1; - if (i > MaxBits) - { - StrIO_WriteString ((const char *) "NumberIO - increase MaxBits", 27); - StrIO_WriteLn (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - buf.array[i-1] = x % 2; - x = x / 2; - } while (! (x == 0)); - j = 0; - Higha = _a_high; - while ((n > i) && (j <= Higha)) - { - a[j] = ' '; - j += 1; - n -= 1; - } - while ((i > 0) && (j <= Higha)) - { - a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0')))); - j += 1; - i -= 1; - } - if (j <= Higha) - { - a[j] = ASCII_nul; - } -} - -extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x) -{ - int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - NumberIO_StrToBinInt ((const char *) a, _a_high, &i); - (*x) = (unsigned int ) (i); -} - -extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if ((a[i] < '0') || (a[i] > '1')) - { - i += 1; - } - else - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - (*x) = (2*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if ((a[i] < '0') || (a[i] > '1')) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if (((a[i] >= '0') && (a[i] <= '9')) || ((a[i] >= 'A') && (a[i] <= 'F'))) - { - ok = FALSE; - } - else - { - i += 1; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - if ((a[i] >= '0') && (a[i] <= '9')) - { - (*x) = (0x010*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - } - else if ((a[i] >= 'A') && (a[i] <= 'F')) - { - /* avoid dangling else. */ - (*x) = (0x010*(*x))+((int ) (( ((unsigned int) (a[i]))- ((unsigned int) ('A')))+10)); - } - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if (((a[i] < '0') || (a[i] > '9')) && ((a[i] < 'A') || (a[i] > 'F'))) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x) -{ - unsigned int i; - unsigned int ok; - unsigned int higha; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high); - higha = StrLib_StrLen ((const char *) a, _a_high); - i = 0; - ok = TRUE; - while (ok) - { - if (i < higha) - { - if ((a[i] < '0') || (a[i] > '7')) - { - i += 1; - } - else - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } - (*x) = 0; - if (i < higha) - { - ok = TRUE; - do { - (*x) = (8*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0')))); - if (i < higha) - { - /* avoid dangling else. */ - i += 1; - if ((a[i] < '0') || (a[i] > '7')) - { - ok = FALSE; - } - } - else - { - ok = FALSE; - } - } while (! (! ok)); - } -} - -extern "C" void _M2_NumberIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_NumberIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GOutput.c b/gcc/m2/pge-boot/GOutput.c deleted file mode 100644 index 22ec0e7b8cf7..000000000000 --- a/gcc/m2/pge-boot/GOutput.c +++ /dev/null @@ -1,315 +0,0 @@ -/* do not edit automatically generated by mc from Output. */ -/* Output.mod redirect output. - -Copyright (C) 2021-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _Output_H -#define _Output_C - -# include "GFIO.h" -# include "GSFIO.h" -# include "GStrLib.h" -# include "GNameKey.h" -# include "GNumberIO.h" -# include "GASCII.h" -# include "GDynamicStrings.h" - -static unsigned int stdout_; -static FIO_File outputFile; -static DynamicStrings_String buffer; - -/* - Open - attempt to open filename as the output file. - TRUE is returned if success, FALSE otherwise. -*/ - -extern "C" unsigned int Output_Open (const char *filename_, unsigned int _filename_high); - -/* - Close - close the output file. -*/ - -extern "C" void Output_Close (void); - -/* - Write - write a single character to the output file. -*/ - -extern "C" void Output_Write (char ch); - -/* - WriteString - write an unformatted string to the output. -*/ - -extern "C" void Output_WriteString (const char *s_, unsigned int _s_high); - -/* - KillWriteS - write a string to the output and free the string afterwards. -*/ - -extern "C" void Output_KillWriteS (DynamicStrings_String s); - -/* - WriteS - write a string to the output. The string is not freed. -*/ - -extern "C" void Output_WriteS (DynamicStrings_String s); - -/* - WriteKey - write a key to the output. -*/ - -extern "C" void Output_WriteKey (NameKey_Name key); - -/* - WriteLn - write a newline to the output. -*/ - -extern "C" void Output_WriteLn (void); - -/* - WriteCard - write a cardinal using fieldlength characters. -*/ - -extern "C" void Output_WriteCard (unsigned int card, unsigned int fieldlength); - -/* - StartBuffer - create a buffer into which any output is redirected. -*/ - -extern "C" void Output_StartBuffer (void); - -/* - EndBuffer - end the redirection and return the contents of the buffer. -*/ - -extern "C" DynamicStrings_String Output_EndBuffer (void); - - -/* - Open - attempt to open filename as the output file. - TRUE is returned if success, FALSE otherwise. -*/ - -extern "C" unsigned int Output_Open (const char *filename_, unsigned int _filename_high) -{ - char filename[_filename_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (filename, filename_, _filename_high+1); - - if ((StrLib_StrEqual ((const char *) filename, _filename_high, (const char *) "", 8)) || (StrLib_StrEqual ((const char *) filename, _filename_high, (const char *) "-", 1))) - { - outputFile = FIO_StdOut; - stdout_ = TRUE; - return TRUE; - } - else - { - outputFile = FIO_OpenToWrite ((const char *) filename, _filename_high); - stdout_ = FALSE; - return FIO_IsNoError (outputFile); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Close - close the output file. -*/ - -extern "C" void Output_Close (void) -{ - FIO_Close (outputFile); -} - - -/* - Write - write a single character to the output file. -*/ - -extern "C" void Output_Write (char ch) -{ - if (buffer == NULL) - { - FIO_WriteChar (outputFile, ch); - } - else - { - buffer = DynamicStrings_ConCatChar (buffer, ch); - } -} - - -/* - WriteString - write an unformatted string to the output. -*/ - -extern "C" void Output_WriteString (const char *s_, unsigned int _s_high) -{ - char s[_s_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (s, s_, _s_high+1); - - if (buffer == NULL) - { - FIO_WriteString (outputFile, (const char *) s, _s_high); - } - else - { - buffer = DynamicStrings_ConCat (buffer, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) s, _s_high))); - } -} - - -/* - KillWriteS - write a string to the output and free the string afterwards. -*/ - -extern "C" void Output_KillWriteS (DynamicStrings_String s) -{ - if ((DynamicStrings_KillString (SFIO_WriteS (outputFile, s))) == NULL) - {} /* empty. */ -} - - -/* - WriteS - write a string to the output. The string is not freed. -*/ - -extern "C" void Output_WriteS (DynamicStrings_String s) -{ - if ((SFIO_WriteS (outputFile, s)) == s) - {} /* empty. */ -} - - -/* - WriteKey - write a key to the output. -*/ - -extern "C" void Output_WriteKey (NameKey_Name key) -{ - if (buffer == NULL) - { - Output_KillWriteS (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (key))); - } - else - { - buffer = DynamicStrings_ConCat (buffer, DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (key)))); - } -} - - -/* - WriteLn - write a newline to the output. -*/ - -extern "C" void Output_WriteLn (void) -{ - if (buffer == NULL) - { - FIO_WriteLine (outputFile); - } - else - { - Output_Write (ASCII_nl); - } -} - - -/* - WriteCard - write a cardinal using fieldlength characters. -*/ - -extern "C" void Output_WriteCard (unsigned int card, unsigned int fieldlength) -{ - typedef struct WriteCard__T1_a WriteCard__T1; - - struct WriteCard__T1_a { char array[20+1]; }; - WriteCard__T1 s; - - NumberIO_CardToStr (card, fieldlength, (char *) &s.array[0], 20); - Output_WriteString ((const char *) &s.array[0], 20); -} - - -/* - StartBuffer - create a buffer into which any output is redirected. -*/ - -extern "C" void Output_StartBuffer (void) -{ - if (buffer != NULL) - { - buffer = DynamicStrings_KillString (buffer); - } - buffer = DynamicStrings_InitString ((const char *) "", 0); -} - - -/* - EndBuffer - end the redirection and return the contents of the buffer. -*/ - -extern "C" DynamicStrings_String Output_EndBuffer (void) -{ - DynamicStrings_String s; - - s = buffer; - buffer = static_cast (NULL); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_Output_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - stdout_ = TRUE; - buffer = static_cast (NULL); - outputFile = FIO_StdOut; -} - -extern "C" void _M2_Output_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GPushBackInput.c b/gcc/m2/pge-boot/GPushBackInput.c deleted file mode 100644 index 3165ce12be43..000000000000 --- a/gcc/m2/pge-boot/GPushBackInput.c +++ /dev/null @@ -1,489 +0,0 @@ -/* do not edit automatically generated by mc from PushBackInput. */ -/* PushBackInput.mod provides a method for pushing back and consuming input. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _PushBackInput_H -#define _PushBackInput_C - -# include "GFIO.h" -# include "GDynamicStrings.h" -# include "GASCII.h" -# include "GDebug.h" -# include "GStrLib.h" -# include "GNumberIO.h" -# include "GStrIO.h" -# include "GStdIO.h" -# include "Glibc.h" - -# define MaxPushBackStack 8192 -# define MaxFileName 4096 -typedef struct PushBackInput__T2_a PushBackInput__T2; - -typedef struct PushBackInput__T3_a PushBackInput__T3; - -struct PushBackInput__T2_a { char array[MaxFileName+1]; }; -struct PushBackInput__T3_a { char array[MaxPushBackStack+1]; }; -static PushBackInput__T2 FileName; -static PushBackInput__T3 CharStack; -static unsigned int ExitStatus; -static unsigned int Column; -static unsigned int StackPtr; -static unsigned int LineNo; -static unsigned int Debugging; - -/* - Open - opens a file for reading. -*/ - -extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high); - -/* - GetCh - gets a character from either the push back stack or - from file, f. -*/ - -extern "C" char PushBackInput_GetCh (FIO_File f); - -/* - PutCh - pushes a character onto the push back stack, it also - returns the character which has been pushed. -*/ - -extern "C" char PushBackInput_PutCh (char ch); - -/* - PutString - pushes a string onto the push back stack. -*/ - -extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high); - -/* - PutStr - pushes a dynamic string onto the push back stack. - The string, s, is not deallocated. -*/ - -extern "C" void PushBackInput_PutStr (DynamicStrings_String s); - -/* - Error - emits an error message with the appropriate file, line combination. -*/ - -extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high); - -/* - WarnError - emits an error message with the appropriate file, line combination. - It does not terminate but when the program finishes an exit status of - 1 will be issued. -*/ - -extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high); - -/* - WarnString - emits an error message with the appropriate file, line combination. - It does not terminate but when the program finishes an exit status of - 1 will be issued. -*/ - -extern "C" void PushBackInput_WarnString (DynamicStrings_String s); - -/* - Close - closes the opened file. -*/ - -extern "C" void PushBackInput_Close (FIO_File f); - -/* - GetExitStatus - returns the exit status which will be 1 if any warnings were issued. -*/ - -extern "C" unsigned int PushBackInput_GetExitStatus (void); - -/* - SetDebug - sets the debug flag on or off. -*/ - -extern "C" void PushBackInput_SetDebug (unsigned int d); - -/* - GetColumnPosition - returns the column position of the current character. -*/ - -extern "C" unsigned int PushBackInput_GetColumnPosition (void); - -/* - GetCurrentLine - returns the current line number. -*/ - -extern "C" unsigned int PushBackInput_GetCurrentLine (void); - -/* - ErrChar - writes a char, ch, to stderr. -*/ - -static void ErrChar (char ch); - -/* - Init - initialize global variables. -*/ - -static void Init (void); - - -/* - ErrChar - writes a char, ch, to stderr. -*/ - -static void ErrChar (char ch) -{ - FIO_WriteChar (FIO_StdErr, ch); -} - - -/* - Init - initialize global variables. -*/ - -static void Init (void) -{ - ExitStatus = 0; - StackPtr = 0; - LineNo = 1; - Column = 0; -} - - -/* - Open - opens a file for reading. -*/ - -extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - Init (); - StrLib_StrCopy ((const char *) a, _a_high, (char *) &FileName.array[0], MaxFileName); - return FIO_OpenToRead ((const char *) a, _a_high); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetCh - gets a character from either the push back stack or - from file, f. -*/ - -extern "C" char PushBackInput_GetCh (FIO_File f) -{ - char ch; - - if (StackPtr > 0) - { - StackPtr -= 1; - if (Debugging) - { - StdIO_Write (CharStack.array[StackPtr]); - } - return CharStack.array[StackPtr]; - } - else - { - if ((FIO_EOF (f)) || (! (FIO_IsNoError (f)))) - { - ch = ASCII_nul; - } - else - { - do { - ch = FIO_ReadChar (f); - } while (! (((ch != ASCII_cr) || (FIO_EOF (f))) || (! (FIO_IsNoError (f))))); - if (ch == ASCII_lf) - { - Column = 0; - LineNo += 1; - } - else - { - Column += 1; - } - } - if (Debugging) - { - StdIO_Write (ch); - } - return ch; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PutCh - pushes a character onto the push back stack, it also - returns the character which has been pushed. -*/ - -extern "C" char PushBackInput_PutCh (char ch) -{ - if (StackPtr < MaxPushBackStack) - { - CharStack.array[StackPtr] = ch; - StackPtr += 1; - } - else - { - Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54); - } - return ch; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PutString - pushes a string onto the push back stack. -*/ - -extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high) -{ - unsigned int l; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - l = StrLib_StrLen ((const char *) a, _a_high); - while (l > 0) - { - l -= 1; - if ((PushBackInput_PutCh (a[l])) != a[l]) - { - Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54); - } - } -} - - -/* - PutStr - pushes a dynamic string onto the push back stack. - The string, s, is not deallocated. -*/ - -extern "C" void PushBackInput_PutStr (DynamicStrings_String s) -{ - unsigned int i; - - i = DynamicStrings_Length (s); - while (i > 0) - { - i -= 1; - if ((PushBackInput_PutCh (DynamicStrings_char (s, static_cast (i)))) != (DynamicStrings_char (s, static_cast (i)))) - { - Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54); - } - } -} - - -/* - Error - emits an error message with the appropriate file, line combination. -*/ - -extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar}); - StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName); - StdIO_Write (':'); - NumberIO_WriteCard (LineNo, 0); - StdIO_Write (':'); - StrIO_WriteString ((const char *) a, _a_high); - StrIO_WriteLn (); - StdIO_PopOutput (); - FIO_Close (FIO_StdErr); - libc_exit (1); -} - - -/* - WarnError - emits an error message with the appropriate file, line combination. - It does not terminate but when the program finishes an exit status of - 1 will be issued. -*/ - -extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar}); - StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName); - StdIO_Write (':'); - NumberIO_WriteCard (LineNo, 0); - StdIO_Write (':'); - StrIO_WriteString ((const char *) a, _a_high); - StrIO_WriteLn (); - StdIO_PopOutput (); - ExitStatus = 1; -} - - -/* - WarnString - emits an error message with the appropriate file, line combination. - It does not terminate but when the program finishes an exit status of - 1 will be issued. -*/ - -extern "C" void PushBackInput_WarnString (DynamicStrings_String s) -{ - typedef char *WarnString__T1; - - WarnString__T1 p; - - p = static_cast (DynamicStrings_string (s)); - StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName); - StdIO_Write (':'); - NumberIO_WriteCard (LineNo, 0); - StdIO_Write (':'); - do { - if (p != NULL) - { - if ((*p) == ASCII_lf) - { - StrIO_WriteLn (); - StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName); - StdIO_Write (':'); - NumberIO_WriteCard (LineNo, 0); - StdIO_Write (':'); - } - else - { - StdIO_Write ((*p)); - } - p += 1; - } - } while (! ((p == NULL) || ((*p) == ASCII_nul))); - ExitStatus = 1; -} - - -/* - Close - closes the opened file. -*/ - -extern "C" void PushBackInput_Close (FIO_File f) -{ - FIO_Close (f); -} - - -/* - GetExitStatus - returns the exit status which will be 1 if any warnings were issued. -*/ - -extern "C" unsigned int PushBackInput_GetExitStatus (void) -{ - return ExitStatus; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SetDebug - sets the debug flag on or off. -*/ - -extern "C" void PushBackInput_SetDebug (unsigned int d) -{ - Debugging = d; -} - - -/* - GetColumnPosition - returns the column position of the current character. -*/ - -extern "C" unsigned int PushBackInput_GetColumnPosition (void) -{ - if (StackPtr > Column) - { - return 0; - } - else - { - return Column-StackPtr; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetCurrentLine - returns the current line number. -*/ - -extern "C" unsigned int PushBackInput_GetCurrentLine (void) -{ - return LineNo; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_PushBackInput_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - PushBackInput_SetDebug (FALSE); - Init (); -} - -extern "C" void _M2_PushBackInput_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GRTExceptions.c b/gcc/m2/pge-boot/GRTExceptions.c deleted file mode 100644 index 5c2eccc2eac5..000000000000 --- a/gcc/m2/pge-boot/GRTExceptions.c +++ /dev/null @@ -1,1226 +0,0 @@ -/* do not edit automatically generated by mc from RTExceptions. */ -/* RTExceptions.mod runtime exception handler routines. - -Copyright (C) 2008-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -#include -# include "GStorage.h" -# include "Gmcrts.h" -#include -#ifndef __cplusplus -extern void throw (unsigned int); -#endif -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _RTExceptions_H -#define _RTExceptions_C - -# include "GASCII.h" -# include "GStrLib.h" -# include "GStorage.h" -# include "GSYSTEM.h" -# include "Glibc.h" -# include "GM2RTS.h" -# include "GSysExceptions.h" -# include "GM2EXCEPTION.h" - -typedef struct RTExceptions_ProcedureHandler_p RTExceptions_ProcedureHandler; - -# define MaxBuffer 4096 -typedef struct RTExceptions__T1_r RTExceptions__T1; - -typedef char *RTExceptions_PtrToChar; - -typedef struct RTExceptions__T2_a RTExceptions__T2; - -typedef struct RTExceptions__T3_r RTExceptions__T3; - -typedef RTExceptions__T3 *RTExceptions_Handler; - -typedef RTExceptions__T1 *RTExceptions_EHBlock; - -typedef void (*RTExceptions_ProcedureHandler_t) (void); -struct RTExceptions_ProcedureHandler_p { RTExceptions_ProcedureHandler_t proc; }; - -struct RTExceptions__T2_a { char array[MaxBuffer+1]; }; -struct RTExceptions__T1_r { - RTExceptions__T2 buffer; - unsigned int number; - RTExceptions_Handler handlers; - RTExceptions_EHBlock right; - }; - -struct RTExceptions__T3_r { - RTExceptions_ProcedureHandler p; - unsigned int n; - RTExceptions_Handler right; - RTExceptions_Handler left; - RTExceptions_Handler stack; - }; - -static unsigned int inException; -static RTExceptions_Handler freeHandler; -static RTExceptions_EHBlock freeEHB; -static RTExceptions_EHBlock currentEHB; -static void * currentSource; - -/* - Raise - invoke the exception handler associated with, number, - in the active EHBlock. It keeps a record of the number - and message in the EHBlock for later use. -*/ - -extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) __attribute__ ((noreturn)); - -/* - SetExceptionBlock - sets, source, as the active EHB. -*/ - -extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source); - -/* - GetExceptionBlock - returns the active EHB. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void); - -/* - GetTextBuffer - returns the address of the EHB buffer. -*/ - -extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e); - -/* - GetTextBufferSize - return the size of the EHB text buffer. -*/ - -extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e); - -/* - GetNumber - return the exception number associated with, - source. -*/ - -extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source); - -/* - InitExceptionBlock - creates and returns a new exception block. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void); - -/* - KillExceptionBlock - destroys the EHB, e, and all its handlers. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e); - -/* - PushHandler - install a handler in EHB, e. -*/ - -extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p); - -/* - PopHandler - removes the handler associated with, number, from - EHB, e. -*/ - -extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number); - -/* - DefaultErrorCatch - displays the current error message in - the current exception block and then - calls HALT. -*/ - -extern "C" void RTExceptions_DefaultErrorCatch (void); - -/* - BaseExceptionsThrow - configures the Modula-2 exceptions to call - THROW which in turn can be caught by an - exception block. If this is not called then - a Modula-2 exception will simply call an - error message routine and then HALT. -*/ - -extern "C" void RTExceptions_BaseExceptionsThrow (void); - -/* - IsInExceptionState - returns TRUE if the program is currently - in the exception state. -*/ - -extern "C" unsigned int RTExceptions_IsInExceptionState (void); - -/* - SetExceptionState - returns the current exception state and - then sets the current exception state to, - to. -*/ - -extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to); - -/* - SwitchExceptionState - assigns, from, with the current exception - state and then assigns the current exception - to, to. -*/ - -extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to); - -/* - GetBaseExceptionBlock - returns the initial language exception block - created. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void); - -/* - SetExceptionSource - sets the current exception source to, source. -*/ - -extern "C" void RTExceptions_SetExceptionSource (void * source); - -/* - GetExceptionSource - returns the current exception source. -*/ - -extern "C" void * RTExceptions_GetExceptionSource (void); - -/* - ErrorString - writes a string to stderr. -*/ - -static void ErrorString (const char *a_, unsigned int _a_high); - -/* - findHandler - -*/ - -static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number); - -/* - InvokeHandler - invokes the associated handler for the current - exception in the active EHB. -*/ - -static void InvokeHandler (void) __attribute__ ((noreturn)); - -/* - DoThrow - throw the exception number in the exception block. -*/ - -static void DoThrow (void); - -/* - addChar - adds, ch, to the current exception handler text buffer - at index, i. The index in then incremented. -*/ - -static void addChar (char ch, unsigned int *i); - -/* - stripPath - returns the filename from the path. -*/ - -static void * stripPath (void * s); - -/* - addFile - adds the filename determined by, s, however it strips - any preceeding path. -*/ - -static void addFile (void * s, unsigned int *i); - -/* - addStr - adds a C string from address, s, into the current - handler text buffer. -*/ - -static void addStr (void * s, unsigned int *i); - -/* - addNum - adds a number, n, to the current handler - text buffer. -*/ - -static void addNum (unsigned int n, unsigned int *i); - -/* - New - returns a new EHBlock. -*/ - -static RTExceptions_EHBlock New (void); - -/* - NewHandler - returns a new handler. -*/ - -static RTExceptions_Handler NewHandler (void); - -/* - KillHandler - returns, NIL, and places, h, onto the free list. -*/ - -static RTExceptions_Handler KillHandler (RTExceptions_Handler h); - -/* - KillHandlers - kills all handlers in the list. -*/ - -static RTExceptions_Handler KillHandlers (RTExceptions_Handler h); - -/* - InitHandler - -*/ - -static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc); - -/* - SubHandler - -*/ - -static void SubHandler (RTExceptions_Handler h); - -/* - AddHandler - add, e, to the end of the list of handlers. -*/ - -static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h); - -/* - indexf - raise an index out of bounds exception. -*/ - -static void indexf (void * a); - -/* - range - raise an assignment out of range exception. -*/ - -static void range (void * a); - -/* - casef - raise a case selector out of range exception. -*/ - -static void casef (void * a); - -/* - invalidloc - raise an invalid location exception. -*/ - -static void invalidloc (void * a); - -/* - function - raise a ... function ... exception. --fixme-- what does this exception catch? -*/ - -static void function (void * a); - -/* - wholevalue - raise an illegal whole value exception. -*/ - -static void wholevalue (void * a); - -/* - wholediv - raise a division by zero exception. -*/ - -static void wholediv (void * a); - -/* - realvalue - raise an illegal real value exception. -*/ - -static void realvalue (void * a); - -/* - realdiv - raise a division by zero in a real number exception. -*/ - -static void realdiv (void * a); - -/* - complexvalue - raise an illegal complex value exception. -*/ - -static void complexvalue (void * a); - -/* - complexdiv - raise a division by zero in a complex number exception. -*/ - -static void complexdiv (void * a); - -/* - protection - raise a protection exception. -*/ - -static void protection (void * a); - -/* - systemf - raise a system exception. -*/ - -static void systemf (void * a); - -/* - coroutine - raise a coroutine exception. -*/ - -static void coroutine (void * a); - -/* - exception - raise a exception exception. -*/ - -static void exception (void * a); - -/* - Init - initialises this module. -*/ - -static void Init (void); - -/* - TidyUp - deallocate memory used by this module. -*/ - -static void TidyUp (void); - - -/* - ErrorString - writes a string to stderr. -*/ - -static void ErrorString (const char *a_, unsigned int _a_high) -{ - int n; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - n = static_cast (libc_write (2, &a, static_cast (StrLib_StrLen ((const char *) a, _a_high)))); -} - - -/* - findHandler - -*/ - -static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number) -{ - RTExceptions_Handler h; - - h = e->handlers->right; - while ((h != e->handlers) && (number != h->n)) - { - h = h->right; - } - if (h == e->handlers) - { - return NULL; - } - else - { - return h; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InvokeHandler - invokes the associated handler for the current - exception in the active EHB. -*/ - -static void InvokeHandler (void) -{ - RTExceptions_Handler h; - - h = findHandler (currentEHB, currentEHB->number); - if (h == NULL) - { - throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ())); - } - else - { - (*h->p.proc) (); - M2RTS_HALT (-1); - __builtin_unreachable (); - } -} - - -/* - DoThrow - throw the exception number in the exception block. -*/ - -static void DoThrow (void) -{ - throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ())); -} - - -/* - addChar - adds, ch, to the current exception handler text buffer - at index, i. The index in then incremented. -*/ - -static void addChar (char ch, unsigned int *i) -{ - if (((*i) <= MaxBuffer) && (currentEHB != NULL)) - { - currentEHB->buffer.array[(*i)] = ch; - (*i) += 1; - } -} - - -/* - stripPath - returns the filename from the path. -*/ - -static void * stripPath (void * s) -{ - RTExceptions_PtrToChar f; - RTExceptions_PtrToChar p; - - p = static_cast (s); - f = static_cast (s); - while ((*p) != ASCII_nul) - { - if ((*p) == '/') - { - p += 1; - f = p; - } - else - { - p += 1; - } - } - return reinterpret_cast (f); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - addFile - adds the filename determined by, s, however it strips - any preceeding path. -*/ - -static void addFile (void * s, unsigned int *i) -{ - RTExceptions_PtrToChar p; - - p = static_cast (stripPath (s)); - while ((p != NULL) && ((*p) != ASCII_nul)) - { - addChar ((*p), i); - p += 1; - } -} - - -/* - addStr - adds a C string from address, s, into the current - handler text buffer. -*/ - -static void addStr (void * s, unsigned int *i) -{ - RTExceptions_PtrToChar p; - - p = static_cast (s); - while ((p != NULL) && ((*p) != ASCII_nul)) - { - addChar ((*p), i); - p += 1; - } -} - - -/* - addNum - adds a number, n, to the current handler - text buffer. -*/ - -static void addNum (unsigned int n, unsigned int *i) -{ - if (n < 10) - { - addChar ( ((char) ((n % 10)+ ((unsigned int) ('0')))), i); - } - else - { - addNum (n / 10, i); - addNum (n % 10, i); - } -} - - -/* - New - returns a new EHBlock. -*/ - -static RTExceptions_EHBlock New (void) -{ - RTExceptions_EHBlock e; - - if (freeEHB == NULL) - { - Storage_ALLOCATE ((void **) &e, sizeof (RTExceptions__T1)); - } - else - { - e = freeEHB; - freeEHB = freeEHB->right; - } - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NewHandler - returns a new handler. -*/ - -static RTExceptions_Handler NewHandler (void) -{ - RTExceptions_Handler h; - - if (freeHandler == NULL) - { - Storage_ALLOCATE ((void **) &h, sizeof (RTExceptions__T3)); - } - else - { - h = freeHandler; - freeHandler = freeHandler->right; - } - return h; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillHandler - returns, NIL, and places, h, onto the free list. -*/ - -static RTExceptions_Handler KillHandler (RTExceptions_Handler h) -{ - h->right = freeHandler; - freeHandler = h; - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillHandlers - kills all handlers in the list. -*/ - -static RTExceptions_Handler KillHandlers (RTExceptions_Handler h) -{ - h->left->right = freeHandler; - freeHandler = h; - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitHandler - -*/ - -static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc) -{ - h->p = proc; - h->n = number; - h->right = r; - h->left = l; - h->stack = s; - return h; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SubHandler - -*/ - -static void SubHandler (RTExceptions_Handler h) -{ - h->right->left = h->left; - h->left->right = h->right; -} - - -/* - AddHandler - add, e, to the end of the list of handlers. -*/ - -static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h) -{ - h->right = e->handlers; - h->left = e->handlers->left; - e->handlers->left->right = h; - e->handlers->left = h; -} - - -/* - indexf - raise an index out of bounds exception. -*/ - -static void indexf (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast (reinterpret_cast("indexf")), const_cast (reinterpret_cast("array index out of bounds"))); -} - - -/* - range - raise an assignment out of range exception. -*/ - -static void range (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast (reinterpret_cast("range")), const_cast (reinterpret_cast("assignment out of range"))); -} - - -/* - casef - raise a case selector out of range exception. -*/ - -static void casef (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast (reinterpret_cast("casef")), const_cast (reinterpret_cast("case selector out of range"))); -} - - -/* - invalidloc - raise an invalid location exception. -*/ - -static void invalidloc (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast (reinterpret_cast("invalidloc")), const_cast (reinterpret_cast("invalid address referenced"))); -} - - -/* - function - raise a ... function ... exception. --fixme-- what does this exception catch? -*/ - -static void function (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast (reinterpret_cast("function")), const_cast (reinterpret_cast("... function ... "))); /* --fixme-- what has happened ? */ -} - - -/* - wholevalue - raise an illegal whole value exception. -*/ - -static void wholevalue (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast (reinterpret_cast("wholevalue")), const_cast (reinterpret_cast("illegal whole value exception"))); -} - - -/* - wholediv - raise a division by zero exception. -*/ - -static void wholediv (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast (reinterpret_cast("wholediv")), const_cast (reinterpret_cast("illegal whole value exception"))); -} - - -/* - realvalue - raise an illegal real value exception. -*/ - -static void realvalue (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast (reinterpret_cast("realvalue")), const_cast (reinterpret_cast("illegal real value exception"))); -} - - -/* - realdiv - raise a division by zero in a real number exception. -*/ - -static void realdiv (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast (reinterpret_cast("realdiv")), const_cast (reinterpret_cast("real number division by zero exception"))); -} - - -/* - complexvalue - raise an illegal complex value exception. -*/ - -static void complexvalue (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast (reinterpret_cast("complexvalue")), const_cast (reinterpret_cast("illegal complex value exception"))); -} - - -/* - complexdiv - raise a division by zero in a complex number exception. -*/ - -static void complexdiv (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast (reinterpret_cast("complexdiv")), const_cast (reinterpret_cast("complex number division by zero exception"))); -} - - -/* - protection - raise a protection exception. -*/ - -static void protection (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast (reinterpret_cast("protection")), const_cast (reinterpret_cast("protection exception"))); -} - - -/* - systemf - raise a system exception. -*/ - -static void systemf (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast (reinterpret_cast("systemf")), const_cast (reinterpret_cast("system exception"))); -} - - -/* - coroutine - raise a coroutine exception. -*/ - -static void coroutine (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast (reinterpret_cast("coroutine")), const_cast (reinterpret_cast("coroutine exception"))); -} - - -/* - exception - raise a exception exception. -*/ - -static void exception (void * a) -{ - RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast (reinterpret_cast("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast (reinterpret_cast("exception")), const_cast (reinterpret_cast("exception exception"))); -} - - -/* - Init - initialises this module. -*/ - -static void Init (void) -{ - inException = FALSE; - freeHandler = NULL; - freeEHB = NULL; - currentEHB = RTExceptions_InitExceptionBlock (); - currentSource = NULL; - RTExceptions_BaseExceptionsThrow (); - SysExceptions_InitExceptionHandlers ((SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) indexf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) range}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) casef}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) invalidloc}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) function}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholevalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholediv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) protection}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) systemf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) coroutine}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) exception}); -} - - -/* - TidyUp - deallocate memory used by this module. -*/ - -static void TidyUp (void) -{ - RTExceptions_Handler f; - RTExceptions_EHBlock e; - - if (currentEHB != NULL) - { - currentEHB = RTExceptions_KillExceptionBlock (currentEHB); - } - while (freeHandler != NULL) - { - f = freeHandler; - freeHandler = freeHandler->right; - Storage_DEALLOCATE ((void **) &f, sizeof (RTExceptions__T3)); - } - while (freeEHB != NULL) - { - e = freeEHB; - freeEHB = freeEHB->right; - Storage_DEALLOCATE ((void **) &e, sizeof (RTExceptions__T1)); - } -} - - -/* - Raise - invoke the exception handler associated with, number, - in the active EHBlock. It keeps a record of the number - and message in the EHBlock for later use. -*/ - -extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) -{ - unsigned int i; - - currentEHB->number = number; - i = 0; - addFile (file, &i); - addChar (':', &i); - addNum (line, &i); - addChar (':', &i); - addNum (column, &i); - addChar (':', &i); - addChar (' ', &i); - addChar ('I', &i); - addChar ('n', &i); - addChar (' ', &i); - addStr (function, &i); - addChar (ASCII_nl, &i); - addFile (file, &i); - addChar (':', &i); - addNum (line, &i); - addChar (':', &i); - addNum (column, &i); - addChar (':', &i); - addStr (message, &i); - addChar (ASCII_nl, &i); - addChar (ASCII_nul, &i); - InvokeHandler (); -} - - -/* - SetExceptionBlock - sets, source, as the active EHB. -*/ - -extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source) -{ - currentEHB = source; -} - - -/* - GetExceptionBlock - returns the active EHB. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void) -{ - return currentEHB; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetTextBuffer - returns the address of the EHB buffer. -*/ - -extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e) -{ - return &e->buffer; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetTextBufferSize - return the size of the EHB text buffer. -*/ - -extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e) -{ - return sizeof (e->buffer); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetNumber - return the exception number associated with, - source. -*/ - -extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source) -{ - return source->number; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - InitExceptionBlock - creates and returns a new exception block. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void) -{ - RTExceptions_EHBlock e; - - e = New (); - e->number = UINT_MAX; - e->handlers = NewHandler (); /* add the dummy onto the head */ - e->handlers->right = e->handlers; /* add the dummy onto the head */ - e->handlers->left = e->handlers; - e->right = e; - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - KillExceptionBlock - destroys the EHB, e, and all its handlers. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e) -{ - e->handlers = KillHandlers (e->handlers); - e->right = freeEHB; - freeEHB = e; - return NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PushHandler - install a handler in EHB, e. -*/ - -extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p) -{ - RTExceptions_Handler h; - RTExceptions_Handler i; - - h = findHandler (e, number); - if (h == NULL) - { - i = InitHandler (NewHandler (), NULL, NULL, NULL, number, p); - } - else - { - /* remove, h, */ - SubHandler (h); - /* stack it onto a new handler */ - i = InitHandler (NewHandler (), NULL, NULL, h, number, p); - } - /* add new handler */ - AddHandler (e, i); -} - - -/* - PopHandler - removes the handler associated with, number, from - EHB, e. -*/ - -extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number) -{ - RTExceptions_Handler h; - RTExceptions_Handler i; - - h = findHandler (e, number); - if (h != NULL) - { - /* remove, h, */ - SubHandler (h); - if (h->stack != NULL) - { - AddHandler (e, h->stack); - } - h = KillHandler (h); - } -} - - -/* - DefaultErrorCatch - displays the current error message in - the current exception block and then - calls HALT. -*/ - -extern "C" void RTExceptions_DefaultErrorCatch (void) -{ - RTExceptions_EHBlock e; - int n; - - e = RTExceptions_GetExceptionBlock (); - n = static_cast (libc_write (2, RTExceptions_GetTextBuffer (e), libc_strlen (RTExceptions_GetTextBuffer (e)))); - M2RTS_HALT (-1); - __builtin_unreachable (); -} - - -/* - BaseExceptionsThrow - configures the Modula-2 exceptions to call - THROW which in turn can be caught by an - exception block. If this is not called then - a Modula-2 exception will simply call an - error message routine and then HALT. -*/ - -extern "C" void RTExceptions_BaseExceptionsThrow (void) -{ - M2EXCEPTION_M2Exceptions i; - - for (i=M2EXCEPTION_indexException; i<=M2EXCEPTION_exException; i= static_cast(static_cast(i+1))) - { - RTExceptions_PushHandler (RTExceptions_GetExceptionBlock (), (unsigned int ) (i), (RTExceptions_ProcedureHandler) {(RTExceptions_ProcedureHandler_t) DoThrow}); - } -} - - -/* - IsInExceptionState - returns TRUE if the program is currently - in the exception state. -*/ - -extern "C" unsigned int RTExceptions_IsInExceptionState (void) -{ - return inException; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SetExceptionState - returns the current exception state and - then sets the current exception state to, - to. -*/ - -extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to) -{ - unsigned int old; - - old = inException; - inException = to; - return old; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SwitchExceptionState - assigns, from, with the current exception - state and then assigns the current exception - to, to. -*/ - -extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to) -{ - (*from) = inException; - inException = to; -} - - -/* - GetBaseExceptionBlock - returns the initial language exception block - created. -*/ - -extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void) -{ - if (currentEHB == NULL) - { - M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39); - } - else - { - return currentEHB; - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1); - __builtin_unreachable (); -} - - -/* - SetExceptionSource - sets the current exception source to, source. -*/ - -extern "C" void RTExceptions_SetExceptionSource (void * source) -{ - currentSource = source; -} - - -/* - GetExceptionSource - returns the current exception source. -*/ - -extern "C" void * RTExceptions_GetExceptionSource (void) -{ - return currentSource; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_RTExceptions_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_RTExceptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - TidyUp (); -} diff --git a/gcc/m2/pge-boot/GRTco.c b/gcc/m2/pge-boot/GRTco.c deleted file mode 100644 index 6365d5ee0b14..000000000000 --- a/gcc/m2/pge-boot/GRTco.c +++ /dev/null @@ -1,127 +0,0 @@ -/* RTco.c provides dummy access to thread primitives. - -Copyright (C) 2019-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -#if defined(__cplusplus) -#define EXTERN extern "C" -#else -#define EXTERN -#endif - -EXTERN -void -RTco_wait (__attribute__ ((unused)) int sid) -{ -} - - -EXTERN -void -RTco_signal (__attribute__ ((unused)) int sid) -{ -} - - -EXTERN -int -RTco_init (void) -{ - return 0; -} - - -EXTERN -int -RTco_initSemaphore (__attribute__ ((unused)) int value) -{ - return 0; -} - - -/* signalThread signal the semaphore associated with thread tid. */ - -EXTERN -void -RTco_signalThread (__attribute__ ((unused)) int tid) -{ -} - - -/* waitThread wait on the semaphore associated with thread tid. */ - -EXTERN -void -RTco_waitThread (__attribute__ ((unused)) int tid) -{ -} - - -EXTERN -int -RTco_currentThread (void) -{ - return 0; -} - - -EXTERN -int -RTco_initThread (__attribute__ ((unused)) void (*proc)(void), - __attribute__ ((unused)) unsigned int stackSize) -{ - return 0; -} - - -EXTERN -void -RTco_transfer (__attribute__ ((unused)) int *p1, __attribute__ ((unused)) int p2) -{ -} - - -EXTERN -int -RTco_select (__attribute__ ((unused)) int p1, - __attribute__ ((unused)) void *p2, - __attribute__ ((unused)) void *p3, - __attribute__ ((unused)) void *p4, - __attribute__ ((unused)) void *p5) -{ - return 0; -} - - -EXTERN -void -_M2_RTco_init (void) -{ -} - -EXTERN -void -_M2_RTco_finish (void) -{ -} diff --git a/gcc/m2/pge-boot/GSFIO.c b/gcc/m2/pge-boot/GSFIO.c deleted file mode 100644 index 4ecfec8e9d2e..000000000000 --- a/gcc/m2/pge-boot/GSFIO.c +++ /dev/null @@ -1,215 +0,0 @@ -/* do not edit automatically generated by mc from SFIO. */ -/* SFIO.mod provides a String interface to the opening routines of FIO. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#include -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _SFIO_H -#define _SFIO_C - -# include "GASCII.h" -# include "GDynamicStrings.h" -# include "GFIO.h" - - -/* - Exists - returns TRUE if a file named, fname exists for reading. -*/ - -extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname); - -/* - OpenToRead - attempts to open a file, fname, for reading and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname); - -/* - OpenToWrite - attempts to open a file, fname, for write and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname); - -/* - OpenForRandom - attempts to open a file, fname, for random access - read or write and it returns this file. - The success of this operation can be checked by - calling IsNoError. - towrite, determines whether the file should be - opened for writing or reading. - if towrite is TRUE or whether the previous file should - be left alone, allowing this descriptor to seek - and modify an existing file. -*/ - -extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile); - -/* - WriteS - writes a string, s, to, file. It returns the String, s. -*/ - -extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s); - -/* - ReadS - reads and returns a string from, file. - It stops reading the string at the end of line or end of file. - It consumes the newline at the end of line but does not place - this into the returned string. -*/ - -extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file); - - -/* - Exists - returns TRUE if a file named, fname exists for reading. -*/ - -extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname) -{ - return FIO_exists (DynamicStrings_string (fname), DynamicStrings_Length (fname)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OpenToRead - attempts to open a file, fname, for reading and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname) -{ - return FIO_openToRead (DynamicStrings_string (fname), DynamicStrings_Length (fname)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OpenToWrite - attempts to open a file, fname, for write and - it returns this file. - The success of this operation can be checked by - calling IsNoError. -*/ - -extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname) -{ - return FIO_openToWrite (DynamicStrings_string (fname), DynamicStrings_Length (fname)); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OpenForRandom - attempts to open a file, fname, for random access - read or write and it returns this file. - The success of this operation can be checked by - calling IsNoError. - towrite, determines whether the file should be - opened for writing or reading. - if towrite is TRUE or whether the previous file should - be left alone, allowing this descriptor to seek - and modify an existing file. -*/ - -extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile) -{ - return FIO_openForRandom (DynamicStrings_string (fname), DynamicStrings_Length (fname), towrite, newfile); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WriteS - writes a string, s, to, file. It returns the String, s. -*/ - -extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s) -{ - unsigned int nBytes; - - if (s != NULL) - { - nBytes = FIO_WriteNBytes (file, DynamicStrings_Length (s), DynamicStrings_string (s)); - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ReadS - reads and returns a string from, file. - It stops reading the string at the end of line or end of file. - It consumes the newline at the end of line but does not place - this into the returned string. -*/ - -extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file) -{ - DynamicStrings_String s; - unsigned int c; - - s = DynamicStrings_InitString ((const char *) "", 0); - while (((! (FIO_EOLN (file))) && (! (FIO_EOF (file)))) && (FIO_IsNoError (file))) - { - s = DynamicStrings_ConCatChar (s, FIO_ReadChar (file)); - } - if (FIO_EOLN (file)) - { - /* consume nl */ - if ((FIO_ReadChar (file)) == ASCII_nul) - {} /* empty. */ - } - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_SFIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_SFIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GSYSTEM.c b/gcc/m2/pge-boot/GSYSTEM.c deleted file mode 100644 index 8b42999fea5f..000000000000 --- a/gcc/m2/pge-boot/GSYSTEM.c +++ /dev/null @@ -1,38 +0,0 @@ -/* GSYSTEM.c a handwritten dummy module for mc. - -Copyright (C) 2018-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#if defined(__cplusplus) -#define EXTERN extern "C" -#else -#define EXTERN -#endif - -EXTERN -void -_M2_SYSTEM_init (int argc, char *p) -{ -} - -EXTERN -void -_M2_SYSTEM_finish (int argc, char *p) -{ -} diff --git a/gcc/m2/pge-boot/GSelective.c b/gcc/m2/pge-boot/GSelective.c deleted file mode 100644 index cf8b541ec409..000000000000 --- a/gcc/m2/pge-boot/GSelective.c +++ /dev/null @@ -1,275 +0,0 @@ -/* GSelective.c provides access to select for Modula-2. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -/* implementation module in C. */ - -#include "config.h" -#include "system.h" -#include "ansidecl.h" - -#include "gm2-libs-host.h" - -#if defined(__cplusplus) -#define EXTERN extern "C" -#else -#define EXTERN -#endif - -/* PROCEDURE Select (nooffds: CARDINAL; readfds, writefds, exceptfds: -SetOfFd; timeout: Timeval) : INTEGER ; */ - -#if defined(HAVE_SELECT) -EXTERN -int -Selective_Select (int nooffds, fd_set *readfds, fd_set *writefds, - fd_set *exceptfds, struct timeval *timeout) -{ - return select (nooffds, readfds, writefds, exceptfds, timeout); -} -#else -EXTERN -int -Selective_Select (int nooffds, void *readfds, void *writefds, void *exceptfds, - void *timeout) -{ - return 0; -} -#endif - -/* PROCEDURE InitTime (sec, usec) : Timeval ; */ - -#if defined(HAVE_SELECT) -EXTERN -struct timeval * -Selective_InitTime (unsigned int sec, unsigned int usec) -{ - struct timeval *t = (struct timeval *)malloc (sizeof (struct timeval)); - - t->tv_sec = (long int)sec; - t->tv_usec = (long int)usec; - return t; -} - -EXTERN -void -Selective_GetTime (struct timeval *t, unsigned int *sec, unsigned int *usec) -{ - *sec = (unsigned int)t->tv_sec; - *usec = (unsigned int)t->tv_usec; -} - -EXTERN -void -Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec) -{ - t->tv_sec = sec; - t->tv_usec = usec; -} - -/* PROCEDURE KillTime (t: Timeval) : Timeval ; */ - -EXTERN -struct timeval * -Selective_KillTime (struct timeval *t) -{ - free (t); - return NULL; -} - -/* PROCEDURE InitSet () : SetOfFd ; */ - -EXTERN -fd_set * -Selective_InitSet (void) -{ - fd_set *s = (fd_set *)malloc (sizeof (fd_set)); - - return s; -} - -/* PROCEDURE KillSet (s: SetOfFd) : SetOfFd ; */ - -EXTERN -fd_set * -Selective_KillSet (fd_set *s) -{ - free (s); - return NULL; -} - -/* PROCEDURE FdZero (s: SetOfFd) ; */ - -EXTERN -void -Selective_FdZero (fd_set *s) -{ - FD_ZERO (s); -} - -/* PROCEDURE Fd_Set (fd: INTEGER; SetOfFd) ; */ - -EXTERN -void -Selective_FdSet (int fd, fd_set *s) -{ - FD_SET (fd, s); -} - -/* PROCEDURE FdClr (fd: INTEGER; SetOfFd) ; */ - -EXTERN -void -Selective_FdClr (int fd, fd_set *s) -{ - FD_CLR (fd, s); -} - -/* PROCEDURE FdIsSet (fd: INTEGER; SetOfFd) : BOOLEAN ; */ - -EXTERN -int -Selective_FdIsSet (int fd, fd_set *s) -{ - return FD_ISSET (fd, s); -} - -/* GetTimeOfDay - fills in a record, Timeval, filled in with the -current system time in seconds and microseconds. It returns zero -(see man 3p gettimeofday) */ - -EXTERN -int -Selective_GetTimeOfDay (struct timeval *t) -{ - return gettimeofday (t, NULL); -} -#else - -EXTERN -void * -Selective_InitTime (unsigned int sec, unsigned int usec) -{ - return NULL; -} - -EXTERN -void * -Selective_KillTime (void *t) -{ - return NULL; -} - -EXTERN -void -Selective_GetTime (struct timeval *t, unsigned int *sec, unsigned int *usec) -{ -} - -EXTERN -void -Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec) -{ -} - -EXTERN -fd_set * -Selective_InitSet (void) -{ - return NULL; -} - -EXTERN -void -Selective_FdZero (void *s) -{ -} - -EXTERN -void -Selective_FdSet (int fd, void *s) -{ -} - -EXTERN -void -Selective_FdClr (int fd, void *s) -{ -} - -EXTERN -int -Selective_FdIsSet (int fd, void *s) -{ - return 0; -} - -EXTERN -int -Selective_GetTimeOfDay (struct timeval *t) -{ - return -1; -} -#endif - -/* PROCEDURE MaxFdsPlusOne (a, b: File) : File ; */ - -EXTERN -int -Selective_MaxFdsPlusOne (int a, int b) -{ - if (a > b) - return a + 1; - else - return b + 1; -} - -/* PROCEDURE WriteCharRaw (fd: INTEGER; ch: CHAR) ; */ - -EXTERN -void -Selective_WriteCharRaw (int fd, char ch) -{ - write (fd, &ch, 1); -} - -/* PROCEDURE ReadCharRaw (fd: INTEGER) : CHAR ; */ - -EXTERN -char -Selective_ReadCharRaw (int fd) -{ - char ch; - - read (fd, &ch, 1); - return ch; -} - -EXTERN -void -_M2_Selective_init () -{ -} - -EXTERN -void -_M2_Selective_finish () -{ -} diff --git a/gcc/m2/pge-boot/GStdIO.c b/gcc/m2/pge-boot/GStdIO.c deleted file mode 100644 index d918673c9acb..000000000000 --- a/gcc/m2/pge-boot/GStdIO.c +++ /dev/null @@ -1,267 +0,0 @@ -/* do not edit automatically generated by mc from StdIO. */ -/* StdIO.mod provides general Read and Write procedures. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# include "Gmcrts.h" -#define _StdIO_H -#define _StdIO_C - -# include "GIO.h" -# include "GM2RTS.h" - -typedef struct StdIO_ProcWrite_p StdIO_ProcWrite; - -typedef struct StdIO_ProcRead_p StdIO_ProcRead; - -# define MaxStack 40 -typedef struct StdIO__T1_a StdIO__T1; - -typedef struct StdIO__T2_a StdIO__T2; - -typedef void (*StdIO_ProcWrite_t) (char); -struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; }; - -typedef void (*StdIO_ProcRead_t) (char *); -struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; }; - -struct StdIO__T1_a { StdIO_ProcWrite array[MaxStack+1]; }; -struct StdIO__T2_a { StdIO_ProcRead array[MaxStack+1]; }; -static StdIO__T1 StackW; -static unsigned int StackWPtr; -static StdIO__T2 StackR; -static unsigned int StackRPtr; - -/* - Read - is the generic procedure that all higher application layers - should use to receive a character. -*/ - -extern "C" void StdIO_Read (char *ch); - -/* - Write - is the generic procedure that all higher application layers - should use to emit a character. -*/ - -extern "C" void StdIO_Write (char ch); - -/* - PushOutput - pushes the current Write procedure onto a stack, - any future references to Write will actually invoke - procedure, p. -*/ - -extern "C" void StdIO_PushOutput (StdIO_ProcWrite p); - -/* - PopOutput - restores Write to use the previous output procedure. -*/ - -extern "C" void StdIO_PopOutput (void); - -/* - GetCurrentOutput - returns the current output procedure. -*/ - -extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void); - -/* - PushInput - pushes the current Read procedure onto a stack, - any future references to Read will actually invoke - procedure, p. -*/ - -extern "C" void StdIO_PushInput (StdIO_ProcRead p); - -/* - PopInput - restores Write to use the previous output procedure. -*/ - -extern "C" void StdIO_PopInput (void); - -/* - GetCurrentInput - returns the current input procedure. -*/ - -extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void); - - -/* - Read - is the generic procedure that all higher application layers - should use to receive a character. -*/ - -extern "C" void StdIO_Read (char *ch) -{ - (*StackR.array[StackRPtr].proc) (ch); -} - - -/* - Write - is the generic procedure that all higher application layers - should use to emit a character. -*/ - -extern "C" void StdIO_Write (char ch) -{ - (*StackW.array[StackWPtr].proc) (ch); -} - - -/* - PushOutput - pushes the current Write procedure onto a stack, - any future references to Write will actually invoke - procedure, p. -*/ - -extern "C" void StdIO_PushOutput (StdIO_ProcWrite p) -{ - if (StackWPtr == MaxStack) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - StackWPtr += 1; - StackW.array[StackWPtr] = p; - } -} - - -/* - PopOutput - restores Write to use the previous output procedure. -*/ - -extern "C" void StdIO_PopOutput (void) -{ - if (StackWPtr == 1) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - StackWPtr -= 1; - } -} - - -/* - GetCurrentOutput - returns the current output procedure. -*/ - -extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void) -{ - if (StackWPtr > 0) - { - return StackW.array[StackWPtr]; - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1); - __builtin_unreachable (); -} - - -/* - PushInput - pushes the current Read procedure onto a stack, - any future references to Read will actually invoke - procedure, p. -*/ - -extern "C" void StdIO_PushInput (StdIO_ProcRead p) -{ - if (StackRPtr == MaxStack) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - StackRPtr += 1; - StackR.array[StackRPtr] = p; - } -} - - -/* - PopInput - restores Write to use the previous output procedure. -*/ - -extern "C" void StdIO_PopInput (void) -{ - if (StackRPtr == 1) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - else - { - StackRPtr -= 1; - } -} - - -/* - GetCurrentInput - returns the current input procedure. -*/ - -extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void) -{ - if (StackRPtr > 0) - { - return StackR.array[StackRPtr]; - } - else - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1); - __builtin_unreachable (); -} - -extern "C" void _M2_StdIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - StackWPtr = 0; - StackRPtr = 0; - StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) IO_Write}); - StdIO_PushInput ((StdIO_ProcRead) {(StdIO_ProcRead_t) IO_Read}); -} - -extern "C" void _M2_StdIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GStorage.c b/gcc/m2/pge-boot/GStorage.c deleted file mode 100644 index d3b8776d5250..000000000000 --- a/gcc/m2/pge-boot/GStorage.c +++ /dev/null @@ -1,72 +0,0 @@ -/* do not edit automatically generated by mc from Storage. */ -/* Storage.mod provides access to the dynamic Storage handler. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#define _Storage_H -#define _Storage_C - -# include "GSysStorage.h" - -extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size); -extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size); -extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size); -extern "C" unsigned int Storage_Available (unsigned int Size); - -extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size) -{ - SysStorage_ALLOCATE (a, Size); -} - -extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size) -{ - SysStorage_DEALLOCATE (a, Size); -} - -extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size) -{ - SysStorage_REALLOCATE (a, Size); -} - -extern "C" unsigned int Storage_Available (unsigned int Size) -{ - return SysStorage_Available (Size); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_Storage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_Storage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GStrCase.c b/gcc/m2/pge-boot/GStrCase.c deleted file mode 100644 index 0e6b5bee012c..000000000000 --- a/gcc/m2/pge-boot/GStrCase.c +++ /dev/null @@ -1,175 +0,0 @@ -/* do not edit automatically generated by mc from StrCase. */ -/* StrCase.mod provides procedure to convert between text case. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -#include -#include -#define _StrCase_H -#define _StrCase_C - -# include "GASCII.h" -# include "GStrLib.h" - - -/* - StrToUpperCase - converts string, a, to uppercase returning the - result in, b. -*/ - -extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high); - -/* - StrToLowerCase - converts string, a, to lowercase returning the - result in, b. -*/ - -extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high); - -/* - Cap - converts a lower case character into a capital character. - If the character is not a lower case character 'a'..'z' - then the character is simply returned unaltered. -*/ - -extern "C" char StrCase_Cap (char ch); - -/* - Lower - converts an upper case character into a lower case character. - If the character is not an upper case character 'A'..'Z' - then the character is simply returned unaltered. -*/ - -extern "C" char StrCase_Lower (char ch); - - -/* - StrToUpperCase - converts string, a, to uppercase returning the - result in, b. -*/ - -extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high) -{ - unsigned int higha; - unsigned int highb; - unsigned int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - higha = StrLib_StrLen ((const char *) a, _a_high); - highb = _b_high; - i = 0; - while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb)) - { - b[i] = StrCase_Cap (a[i]); - i += 1; - } - if (i < highb) - { - b[i] = ASCII_nul; - } -} - - -/* - StrToLowerCase - converts string, a, to lowercase returning the - result in, b. -*/ - -extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high) -{ - unsigned int higha; - unsigned int highb; - unsigned int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - higha = StrLib_StrLen ((const char *) a, _a_high); - highb = _b_high; - i = 0; - while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb)) - { - b[i] = StrCase_Lower (a[i]); - i += 1; - } - if (i < highb) - { - b[i] = ASCII_nul; - } -} - - -/* - Cap - converts a lower case character into a capital character. - If the character is not a lower case character 'a'..'z' - then the character is simply returned unaltered. -*/ - -extern "C" char StrCase_Cap (char ch) -{ - if ((ch >= 'a') && (ch <= 'z')) - { - ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A')))); - } - return ch; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Lower - converts an upper case character into a lower case character. - If the character is not an upper case character 'A'..'Z' - then the character is simply returned unaltered. -*/ - -extern "C" char StrCase_Lower (char ch) -{ - if ((ch >= 'A') && (ch <= 'Z')) - { - ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a')))); - } - return ch; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" void _M2_StrCase_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_StrCase_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GStrIO.c b/gcc/m2/pge-boot/GStrIO.c deleted file mode 100644 index b8c42ac162a3..000000000000 --- a/gcc/m2/pge-boot/GStrIO.c +++ /dev/null @@ -1,277 +0,0 @@ -/* do not edit automatically generated by mc from StrIO. */ -/* StrIO.mod provides simple string input output routines. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#define _StrIO_H -#define _StrIO_C - -# include "GASCII.h" -# include "GStdIO.h" -# include "Glibc.h" - -static unsigned int IsATTY; - -/* - WriteLn - writes a carriage return and a newline - character. -*/ - -extern "C" void StrIO_WriteLn (void); - -/* - ReadString - reads a sequence of characters into a string. - Line editing accepts Del, Ctrl H, Ctrl W and - Ctrl U. -*/ - -extern "C" void StrIO_ReadString (char *a, unsigned int _a_high); - -/* - WriteString - writes a string to the default output. -*/ - -extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high); - -/* - Erase - writes a backspace, space and backspace to remove the - last character displayed. -*/ - -static void Erase (void); - -/* - Echo - echos the character, ch, onto the output channel if IsATTY - is true. -*/ - -static void Echo (char ch); - -/* - AlphaNum- returns true if character, ch, is an alphanumeric character. -*/ - -static unsigned int AlphaNum (char ch); - - -/* - Erase - writes a backspace, space and backspace to remove the - last character displayed. -*/ - -static void Erase (void) -{ - Echo (ASCII_bs); - Echo (' '); - Echo (ASCII_bs); -} - - -/* - Echo - echos the character, ch, onto the output channel if IsATTY - is true. -*/ - -static void Echo (char ch) -{ - if (IsATTY) - { - StdIO_Write (ch); - } -} - - -/* - AlphaNum- returns true if character, ch, is an alphanumeric character. -*/ - -static unsigned int AlphaNum (char ch) -{ - return (((ch >= 'a') && (ch <= 'z')) || ((ch >= 'A') && (ch <= 'Z'))) || ((ch >= '0') && (ch <= '9')); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WriteLn - writes a carriage return and a newline - character. -*/ - -extern "C" void StrIO_WriteLn (void) -{ - Echo (ASCII_cr); - StdIO_Write (ASCII_lf); -} - - -/* - ReadString - reads a sequence of characters into a string. - Line editing accepts Del, Ctrl H, Ctrl W and - Ctrl U. -*/ - -extern "C" void StrIO_ReadString (char *a, unsigned int _a_high) -{ - unsigned int n; - unsigned int high; - char ch; - - high = _a_high; - n = 0; - do { - StdIO_Read (&ch); - if ((ch == ASCII_del) || (ch == ASCII_bs)) - { - if (n == 0) - { - StdIO_Write (ASCII_bel); - } - else - { - Erase (); - n -= 1; - } - } - else if (ch == ASCII_nak) - { - /* avoid dangling else. */ - while (n > 0) - { - Erase (); - n -= 1; - } - } - else if (ch == ASCII_etb) - { - /* avoid dangling else. */ - if (n == 0) - { - Echo (ASCII_bel); - } - else if (AlphaNum (a[n-1])) - { - /* avoid dangling else. */ - do { - Erase (); - n -= 1; - } while (! ((n == 0) || (! (AlphaNum (a[n-1]))))); - } - else - { - /* avoid dangling else. */ - Erase (); - n -= 1; - } - } - else if (n <= high) - { - /* avoid dangling else. */ - if ((ch == ASCII_cr) || (ch == ASCII_lf)) - { - a[n] = ASCII_nul; - n += 1; - } - else if (ch == ASCII_ff) - { - /* avoid dangling else. */ - a[0] = ch; - if (high > 0) - { - a[1] = ASCII_nul; - } - ch = ASCII_cr; - } - else if (ch >= ' ') - { - /* avoid dangling else. */ - Echo (ch); - a[n] = ch; - n += 1; - } - else if (ch == ASCII_eof) - { - /* avoid dangling else. */ - a[n] = ch; - n += 1; - ch = ASCII_cr; - if (n <= high) - { - a[n] = ASCII_nul; - } - } - } - else if (ch != ASCII_cr) - { - /* avoid dangling else. */ - Echo (ASCII_bel); - } - } while (! ((ch == ASCII_cr) || (ch == ASCII_lf))); -} - - -/* - WriteString - writes a string to the default output. -*/ - -extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high) -{ - unsigned int n; - unsigned int high; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - high = _a_high; - n = 0; - while ((n <= high) && (a[n] != ASCII_nul)) - { - StdIO_Write (a[n]); - n += 1; - } -} - -extern "C" void _M2_StrIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - /* IsATTY := isatty() */ - IsATTY = FALSE; -} - -extern "C" void _M2_StrIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GStrLib.c b/gcc/m2/pge-boot/GStrLib.c deleted file mode 100644 index d5ae7249d893..000000000000 --- a/gcc/m2/pge-boot/GStrLib.c +++ /dev/null @@ -1,346 +0,0 @@ -/* do not edit automatically generated by mc from StrLib. */ -/* StrLib.mod provides string manipulation procedures. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#define _StrLib_H -#define _StrLib_C - -# include "GASCII.h" - - -/* - StrConCat - combines a and b into c. -*/ - -extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high); - -/* - StrLess - returns TRUE if string, a, alphabetically occurs before - string, b. -*/ - -extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); -extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); -extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high); - -/* - StrCopy - copy string src into string dest providing dest is large enough. - If dest is smaller than a then src then the string is truncated when - dest is full. Add a nul character if there is room in dest. -*/ - -extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high); - -/* - IsSubString - returns true if b is a subcomponent of a. -*/ - -extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high); - -/* - StrRemoveWhitePrefix - copies string, into string, b, excluding any white - space infront of a. -*/ - -extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high); - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch); - - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch) -{ - return (ch == ' ') || (ch == ASCII_tab); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StrConCat - combines a and b into c. -*/ - -extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high) -{ - unsigned int Highb; - unsigned int Highc; - unsigned int i; - unsigned int j; - char a[_a_high+1]; - char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - Highb = StrLib_StrLen ((const char *) b, _b_high); - Highc = _c_high; - StrLib_StrCopy ((const char *) a, _a_high, (char *) c, _c_high); - i = StrLib_StrLen ((const char *) c, _c_high); - j = 0; - while ((j < Highb) && (i <= Highc)) - { - c[i] = b[j]; - i += 1; - j += 1; - } - if (i <= Highc) - { - c[i] = ASCII_nul; - } -} - - -/* - StrLess - returns TRUE if string, a, alphabetically occurs before - string, b. -*/ - -extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high) -{ - unsigned int Higha; - unsigned int Highb; - unsigned int i; - char a[_a_high+1]; - char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - Higha = StrLib_StrLen ((const char *) a, _a_high); - Highb = StrLib_StrLen ((const char *) b, _b_high); - i = 0; - while ((i < Higha) && (i < Highb)) - { - if (a[i] < b[i]) - { - return TRUE; - } - else if (a[i] > b[i]) - { - /* avoid dangling else. */ - return FALSE; - } - /* must be equal, move on to next character */ - i += 1; - } - return Higha < Highb; /* substrings are equal so we go on length */ - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned int higha; - unsigned int highb; - char a[_a_high+1]; - char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - higha = _a_high; - highb = _b_high; - i = 0; - while ((((i <= higha) && (i <= highb)) && (a[i] != ASCII_nul)) && (b[i] != ASCII_nul)) - { - if (a[i] != b[i]) - { - return FALSE; - } - i += 1; - } - return ! (((i <= higha) && (a[i] != ASCII_nul)) || ((i <= highb) && (b[i] != ASCII_nul))); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - -extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high) -{ - unsigned int High; - unsigned int Len; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - Len = 0; - High = _a_high; - while ((Len <= High) && (a[Len] != ASCII_nul)) - { - Len += 1; - } - return Len; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StrCopy - copy string src into string dest providing dest is large enough. - If dest is smaller than a then src then the string is truncated when - dest is full. Add a nul character if there is room in dest. -*/ - -extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high) -{ - unsigned int HighSrc; - unsigned int HighDest; - unsigned int n; - char src[_src_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (src, src_, _src_high+1); - - n = 0; - HighSrc = StrLib_StrLen ((const char *) src, _src_high); - HighDest = _dest_high; - while ((n < HighSrc) && (n <= HighDest)) - { - dest[n] = src[n]; - n += 1; - } - if (n <= HighDest) - { - dest[n] = ASCII_nul; - } -} - - -/* - IsSubString - returns true if b is a subcomponent of a. -*/ - -extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high) -{ - unsigned int i; - unsigned int j; - unsigned int LengthA; - unsigned int LengthB; - char a[_a_high+1]; - char b[_b_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - memcpy (b, b_, _b_high+1); - - LengthA = StrLib_StrLen ((const char *) a, _a_high); - LengthB = StrLib_StrLen ((const char *) b, _b_high); - i = 0; - if (LengthA > LengthB) - { - while (i <= (LengthA-LengthB)) - { - j = 0; - while ((j < LengthB) && (a[i+j] == b[j])) - { - j += 1; - } - if (j == LengthB) - { - return TRUE; - } - else - { - i += 1; - } - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - StrRemoveWhitePrefix - copies string, into string, b, excluding any white - space infront of a. -*/ - -extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high) -{ - unsigned int i; - unsigned int j; - unsigned int higha; - unsigned int highb; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = 0; - j = 0; - higha = StrLib_StrLen ((const char *) a, _a_high); - highb = _b_high; - while ((i < higha) && (IsWhite (a[i]))) - { - i += 1; - } - while ((i < higha) && (j <= highb)) - { - b[j] = a[i]; - i += 1; - j += 1; - } - if (j <= highb) - { - b[j] = ASCII_nul; - } -} - -extern "C" void _M2_StrLib_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_StrLib_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GSymbolKey.c b/gcc/m2/pge-boot/GSymbolKey.c deleted file mode 100644 index 699b70a5c626..000000000000 --- a/gcc/m2/pge-boot/GSymbolKey.c +++ /dev/null @@ -1,556 +0,0 @@ -/* do not edit automatically generated by mc from SymbolKey. */ -/* SymbolKey.mod binary tree operations for storing symbols. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -# include "GStorage.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _SymbolKey_H -#define _SymbolKey_C - -# include "GStorage.h" -# include "GStrIO.h" -# include "GNumberIO.h" -# include "GNameKey.h" -# include "GAssertion.h" -# include "GDebug.h" - -# define SymbolKey_NulKey 0 -typedef struct SymbolKey_IsSymbol_p SymbolKey_IsSymbol; - -typedef struct SymbolKey_PerformOperation_p SymbolKey_PerformOperation; - -typedef struct SymbolKey_Node_r SymbolKey_Node; - -typedef SymbolKey_Node *SymbolKey_SymbolTree; - -typedef unsigned int (*SymbolKey_IsSymbol_t) (unsigned int); -struct SymbolKey_IsSymbol_p { SymbolKey_IsSymbol_t proc; }; - -typedef void (*SymbolKey_PerformOperation_t) (unsigned int); -struct SymbolKey_PerformOperation_p { SymbolKey_PerformOperation_t proc; }; - -struct SymbolKey_Node_r { - NameKey_Name KeyName; - unsigned int KeySym; - SymbolKey_SymbolTree Left; - SymbolKey_SymbolTree Right; - }; - -extern "C" void SymbolKey_InitTree (SymbolKey_SymbolTree *t); -extern "C" void SymbolKey_KillTree (SymbolKey_SymbolTree *t); - -/* - ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey. -*/ - -extern "C" unsigned int SymbolKey_GetSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey); - -/* - ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey. -*/ - -extern "C" void SymbolKey_PutSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey, unsigned int SymKey); - -/* - DelSymKey - deletes an entry in the binary tree. - - NB in order for this to work we must ensure that the InitTree sets - both Left and Right to NIL. -*/ - -extern "C" void SymbolKey_DelSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey); - -/* - IsEmptyTree - returns true if SymbolTree, t, is empty. -*/ - -extern "C" unsigned int SymbolKey_IsEmptyTree (SymbolKey_SymbolTree t); - -/* - DoesTreeContainAny - returns true if SymbolTree, t, contains any - symbols which in turn return true when procedure, - P, is called with a symbol as its parameter. - The SymbolTree root is empty apart from the field, - Left, hence we need two procedures. -*/ - -extern "C" unsigned int SymbolKey_DoesTreeContainAny (SymbolKey_SymbolTree t, SymbolKey_IsSymbol P); - -/* - ForeachNodeDo - for each node in SymbolTree, t, a procedure, P, - is called with the node symbol as its parameter. - The tree root node only contains a legal Left pointer, - therefore we need two procedures to examine this tree. -*/ - -extern "C" void SymbolKey_ForeachNodeDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P); - -/* - ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey. -*/ - -extern "C" unsigned int SymbolKey_ContainsSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey); - -/* - NoOfNodes - returns the number of nodes in the tree t. -*/ - -extern "C" unsigned int SymbolKey_NoOfNodes (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition); - -/* - ForeachNodeConditionDo - traverse the tree t and for any node which satisfied - condition call P. -*/ - -extern "C" void SymbolKey_ForeachNodeConditionDo (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P); - -/* - FindNodeParentInTree - find a node, child, in a binary tree, t, with name equal to n. - if an entry is found, parent is set to the node above child. -*/ - -static void FindNodeParentInTree (SymbolKey_SymbolTree t, NameKey_Name n, SymbolKey_SymbolTree *child, SymbolKey_SymbolTree *parent); - -/* - SearchForAny - performs the search required for DoesTreeContainAny. - The root node always contains a nul data value, - therefore we must skip over it. -*/ - -static unsigned int SearchForAny (SymbolKey_SymbolTree t, SymbolKey_IsSymbol P); - -/* - SearchAndDo - searches all the nodes in SymbolTree, t, and - calls procedure, P, with a node as its parameter. - It traverse the tree in order. -*/ - -static void SearchAndDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P); - -/* - CountNodes - wrapper for NoOfNodes. -*/ - -static unsigned int CountNodes (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, unsigned int count); - -/* - SearchConditional - wrapper for ForeachNodeConditionDo. -*/ - -static void SearchConditional (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P); - - -/* - FindNodeParentInTree - find a node, child, in a binary tree, t, with name equal to n. - if an entry is found, parent is set to the node above child. -*/ - -static void FindNodeParentInTree (SymbolKey_SymbolTree t, NameKey_Name n, SymbolKey_SymbolTree *child, SymbolKey_SymbolTree *parent) -{ - /* remember to skip the sentinal value and assign parent and child */ - (*parent) = t; - if (t == NULL) - { - Debug_Halt ((const char *) "parameter t should never be NIL", 31, 240, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54); - } - Assertion_Assert (t->Right == NULL); - (*child) = t->Left; - if ((*child) != NULL) - { - do { - if (n < (*child)->KeyName) - { - (*parent) = (*child); - (*child) = (*child)->Left; - } - else if (n > (*child)->KeyName) - { - /* avoid dangling else. */ - (*parent) = (*child); - (*child) = (*child)->Right; - } - } while (! (((*child) == NULL) || (n == (*child)->KeyName))); - } -} - - -/* - SearchForAny - performs the search required for DoesTreeContainAny. - The root node always contains a nul data value, - therefore we must skip over it. -*/ - -static unsigned int SearchForAny (SymbolKey_SymbolTree t, SymbolKey_IsSymbol P) -{ - if (t == NULL) - { - return FALSE; - } - else - { - return (((*P.proc) (t->KeySym)) || (SearchForAny (t->Left, P))) || (SearchForAny (t->Right, P)); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SearchAndDo - searches all the nodes in SymbolTree, t, and - calls procedure, P, with a node as its parameter. - It traverse the tree in order. -*/ - -static void SearchAndDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P) -{ - if (t != NULL) - { - SearchAndDo (t->Right, P); - (*P.proc) (t->KeySym); - SearchAndDo (t->Left, P); - } -} - - -/* - CountNodes - wrapper for NoOfNodes. -*/ - -static unsigned int CountNodes (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, unsigned int count) -{ - if (t != NULL) - { - if ((*condition.proc) (t->KeySym)) - { - count += 1; - } - count = CountNodes (t->Left, condition, count); - count = CountNodes (t->Right, condition, count); - } - return count; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SearchConditional - wrapper for ForeachNodeConditionDo. -*/ - -static void SearchConditional (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P) -{ - if (t != NULL) - { - SearchConditional (t->Right, condition, P); - if ((t->KeySym != 0) && ((*condition.proc) (t->KeySym))) - { - (*P.proc) (t->KeySym); - } - SearchConditional (t->Left, condition, P); - } -} - -extern "C" void SymbolKey_InitTree (SymbolKey_SymbolTree *t) -{ - Storage_ALLOCATE ((void **) &(*t), sizeof (SymbolKey_Node)); /* The value entity */ - (*t)->Left = NULL; - (*t)->Right = NULL; -} - -extern "C" void SymbolKey_KillTree (SymbolKey_SymbolTree *t) -{ - /* - we used to get problems compiling KillTree below - so it was split - into the two procedures below. - - -PROCEDURE KillTree (VAR t: SymbolTree) ; -BEGIN - IF t#NIL - THEN - Kill(t) ; Would like to place Kill in here but the compiler - gives a type incompatible error... so i've split - the procedure into two. - Problem i think with - VAR t at the top? - t := NIL - END -END KillTree ; - - -PROCEDURE Kill (t: SymbolTree) ; -BEGIN - IF t#NIL - THEN - Kill(t^.Left) ; - Kill(t^.Right) ; - DISPOSE(t) - END -END Kill ; - */ - if ((*t) != NULL) - { - SymbolKey_KillTree (&(*t)->Left); - SymbolKey_KillTree (&(*t)->Right); - Storage_DEALLOCATE ((void **) &(*t), sizeof (SymbolKey_Node)); - (*t) = NULL; - } -} - - -/* - ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey. -*/ - -extern "C" unsigned int SymbolKey_GetSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey) -{ - SymbolKey_SymbolTree father; - SymbolKey_SymbolTree child; - - FindNodeParentInTree (t, NameKey, &child, &father); - if (child == NULL) - { - return static_cast (SymbolKey_NulKey); - } - else - { - return child->KeySym; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey. -*/ - -extern "C" void SymbolKey_PutSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey, unsigned int SymKey) -{ - SymbolKey_SymbolTree father; - SymbolKey_SymbolTree child; - - FindNodeParentInTree (t, NameKey, &child, &father); - if (child == NULL) - { - /* no child found, now is NameKey less than father or greater? */ - if (father == t) - { - /* empty tree, add it to the left branch of t */ - Storage_ALLOCATE ((void **) &child, sizeof (SymbolKey_Node)); - father->Left = child; - } - else - { - if (NameKey < father->KeyName) - { - Storage_ALLOCATE ((void **) &child, sizeof (SymbolKey_Node)); - father->Left = child; - } - else if (NameKey > father->KeyName) - { - /* avoid dangling else. */ - Storage_ALLOCATE ((void **) &child, sizeof (SymbolKey_Node)); - father->Right = child; - } - } - child->Right = NULL; - child->Left = NULL; - child->KeySym = SymKey; - child->KeyName = NameKey; - } - else - { - Debug_Halt ((const char *) "symbol already stored", 21, 156, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54); - } -} - - -/* - DelSymKey - deletes an entry in the binary tree. - - NB in order for this to work we must ensure that the InitTree sets - both Left and Right to NIL. -*/ - -extern "C" void SymbolKey_DelSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey) -{ - SymbolKey_SymbolTree i; - SymbolKey_SymbolTree child; - SymbolKey_SymbolTree father; - - FindNodeParentInTree (t, NameKey, &child, &father); /* find father and child of the node */ - if ((child != NULL) && (child->KeyName == NameKey)) - { - /* Have found the node to be deleted */ - if (father->Right == child) - { - /* most branch of child^.Left. */ - if (child->Left != NULL) - { - /* Scan for Right most node of child^.Left */ - i = child->Left; - while (i->Right != NULL) - { - i = i->Right; - } - i->Right = child->Right; - father->Right = child->Left; - } - else - { - /* (as in a single linked list) to child^.Right */ - father->Right = child->Right; - } - Storage_DEALLOCATE ((void **) &child, sizeof (SymbolKey_Node)); - } - else - { - /* branch of child^.Right */ - if (child->Right != NULL) - { - /* Scan for Left most node of child^.Right */ - i = child->Right; - while (i->Left != NULL) - { - i = i->Left; - } - i->Left = child->Left; - father->Left = child->Right; - } - else - { - /* (as in a single linked list) to child^.Left. */ - father->Left = child->Left; - } - Storage_DEALLOCATE ((void **) &child, sizeof (SymbolKey_Node)); - } - } - else - { - Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 223, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54); - } -} - - -/* - IsEmptyTree - returns true if SymbolTree, t, is empty. -*/ - -extern "C" unsigned int SymbolKey_IsEmptyTree (SymbolKey_SymbolTree t) -{ - return t->Left == NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DoesTreeContainAny - returns true if SymbolTree, t, contains any - symbols which in turn return true when procedure, - P, is called with a symbol as its parameter. - The SymbolTree root is empty apart from the field, - Left, hence we need two procedures. -*/ - -extern "C" unsigned int SymbolKey_DoesTreeContainAny (SymbolKey_SymbolTree t, SymbolKey_IsSymbol P) -{ - return SearchForAny (t->Left, P); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ForeachNodeDo - for each node in SymbolTree, t, a procedure, P, - is called with the node symbol as its parameter. - The tree root node only contains a legal Left pointer, - therefore we need two procedures to examine this tree. -*/ - -extern "C" void SymbolKey_ForeachNodeDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P) -{ - SearchAndDo (t->Left, P); -} - - -/* - ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey. -*/ - -extern "C" unsigned int SymbolKey_ContainsSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey) -{ - SymbolKey_SymbolTree father; - SymbolKey_SymbolTree child; - - FindNodeParentInTree (t, NameKey, &child, &father); - return child != NULL; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NoOfNodes - returns the number of nodes in the tree t. -*/ - -extern "C" unsigned int SymbolKey_NoOfNodes (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition) -{ - return CountNodes (t->Left, condition, 0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ForeachNodeConditionDo - traverse the tree t and for any node which satisfied - condition call P. -*/ - -extern "C" void SymbolKey_ForeachNodeConditionDo (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P) -{ - if (t != NULL) - { - Assertion_Assert (t->Right == NULL); - SearchConditional (t->Left, condition, P); - } -} - -extern "C" void _M2_SymbolKey_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} - -extern "C" void _M2_SymbolKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/GSysExceptions.c b/gcc/m2/pge-boot/GSysExceptions.c deleted file mode 100644 index 4e600565fe87..000000000000 --- a/gcc/m2/pge-boot/GSysExceptions.c +++ /dev/null @@ -1,237 +0,0 @@ -/* GSysExceptions.c low level module interfacing exceptions to the OS. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" - -#include "gm2-libs-host.h" - -#if defined(__cplusplus) -#define EXTERN extern "C" -#else -#define EXTERN -#endif - -#if 0 -/* Signals. */ -#define SIGHUP 1 /* Hangup (POSIX). */ -#define SIGINT 2 /* Interrupt (ANSI). */ -#define SIGQUIT 3 /* Quit (POSIX). */ -#define SIGILL 4 /* Illegal instruction (ANSI). */ -#define SIGTRAP 5 /* Trace trap (POSIX). */ -#define SIGABRT 6 /* Abort (ANSI). */ -#define SIGIOT 6 /* IOT trap (4.2 BSD). */ -#define SIGBUS 7 /* BUS error (4.2 BSD). */ -#define SIGFPE 8 /* Floating-point exception (ANSI). */ -#define SIGKILL 9 /* Kill, unblockable (POSIX). */ -#define SIGUSR1 10 /* User-defined signal 1 (POSIX). */ -#define SIGSEGV 11 /* Segmentation violation (ANSI). */ -#define SIGUSR2 12 /* User-defined signal 2 (POSIX). */ -#define SIGPIPE 13 /* Broken pipe (POSIX). */ -#define SIGALRM 14 /* Alarm clock (POSIX). */ -#define SIGTERM 15 /* Termination (ANSI). */ -#define SIGSTKFLT 16 /* Stack fault. */ -#define SIGCLD SIGCHLD /* Same as SIGCHLD (System V). */ -#define SIGCHLD 17 /* Child status has changed (POSIX). */ -#define SIGCONT 18 /* Continue (POSIX). */ -#define SIGSTOP 19 /* Stop, unblockable (POSIX). */ -#define SIGTSTP 20 /* Keyboard stop (POSIX). */ -#define SIGTTIN 21 /* Background read from tty (POSIX). */ -#define SIGTTOU 22 /* Background write to tty (POSIX). */ -#define SIGURG 23 /* Urgent condition on socket (4.2 BSD). */ -#define SIGXCPU 24 /* CPU limit exceeded (4.2 BSD). */ -#define SIGXFSZ 25 /* File size limit exceeded (4.2 BSD). */ -#define SIGVTALRM 26 /* Virtual alarm clock (4.2 BSD). */ -#define SIGPROF 27 /* Profiling alarm clock (4.2 BSD). */ -#define SIGWINCH 28 /* Window size change (4.3 BSD, Sun). */ -#define SIGPOLL SIGIO /* Pollable event occurred (System V). */ -#define SIGIO 29 /* I/O now possible (4.2 BSD). */ -#define SIGPWR 30 /* Power failure restart (System V). */ -#define SIGSYS 31 /* Bad system call. */ -#define SIGUNUSED 31 - - - (indexException, rangeException, caseSelectException, invalidLocation, - functionException, wholeValueException, wholeDivException, realValueException, - realDivException, complexValueException, complexDivException, protException, - sysException, coException, exException - ); - -#endif - -/* wholeDivException and realDivException are caught by SIGFPE - and depatched to the appropriate Modula-2 runtime routine upon - testing FPE_INTDIV or FPE_FLTDIV. realValueException is also - caught by SIGFPE and dispatched by testing FFE_FLTOVF or - FPE_FLTUND or FPE_FLTRES or FPE_FLTINV. indexException is - caught by SIGFPE and dispatched by FPE_FLTSUB. */ - -#if defined(HAVE_SIGNAL_H) -static struct sigaction sigbus; -static struct sigaction sigfpe_; -static struct sigaction sigsegv; - -static void (*indexProc) (void *); -static void (*rangeProc) (void *); -static void (*assignmentrangeProc) (void *); -static void (*caseProc) (void *); -static void (*invalidlocProc) (void *); -static void (*functionProc) (void *); -static void (*wholevalueProc) (void *); -static void (*wholedivProc) (void *); -static void (*realvalueProc) (void *); -static void (*realdivProc) (void *); -static void (*complexvalueProc) (void *); -static void (*complexdivProc) (void *); -static void (*protectionProc) (void *); -static void (*systemProc) (void *); -static void (*coroutineProc) (void *); -static void (*exceptionProc) (void *); - -static void -sigbusDespatcher (int signum, siginfo_t *info, void *ucontext) -{ - switch (signum) - { - - case SIGSEGV: - case SIGBUS: - if (info) - (*invalidlocProc) (info->si_addr); - break; - default: - perror ("not expecting to arrive here with this signal"); - } -} - -static void -sigfpeDespatcher (int signum, siginfo_t *info, void *ucontext) -{ - switch (signum) - { - - case SIGFPE: - if (info) - { - if (info->si_code | FPE_INTDIV) - (*wholedivProc) (info->si_addr); /* integer divide by zero. */ - if (info->si_code | FPE_INTOVF) - (*wholevalueProc) (info->si_addr); /* integer overflow. */ - if (info->si_code | FPE_FLTDIV) - (*realdivProc) ( - info->si_addr); /* floating-point divide by zero. */ - if (info->si_code | FPE_FLTOVF) - (*realvalueProc) (info->si_addr); /* floating-point overflow. */ - if (info->si_code | FPE_FLTUND) - (*realvalueProc) (info->si_addr); /* floating-point underflow. */ - if (info->si_code | FPE_FLTRES) - (*realvalueProc) ( - info->si_addr); /* floating-point inexact result. */ - if (info->si_code | FPE_FLTINV) - (*realvalueProc) ( - info->si_addr); /* floating-point invalid result. */ - if (info->si_code | FPE_FLTSUB) - (*indexProc) (info->si_addr); /* subscript out of range. */ - } - break; - default: - perror ("not expecting to arrive here with this signal"); - } -} - -EXTERN -void -SysExceptions_InitExceptionHandlers ( - void (*indexf) (void *), void (*range) (void *), void (*casef) (void *), - void (*invalidloc) (void *), void (*function) (void *), - void (*wholevalue) (void *), void (*wholediv) (void *), - void (*realvalue) (void *), void (*realdiv) (void *), - void (*complexvalue) (void *), void (*complexdiv) (void *), - void (*protection) (void *), void (*systemf) (void *), - void (*coroutine) (void *), void (*exception) (void *)) -{ - struct sigaction old; - - indexProc = indexf; - rangeProc = range; - caseProc = casef; - invalidlocProc = invalidloc; - functionProc = function; - wholevalueProc = wholevalue; - wholedivProc = wholediv; - realvalueProc = realvalue; - realdivProc = realdiv; - complexvalueProc = complexvalue; - complexdivProc = complexdiv; - protectionProc = protection; - systemProc = systemf; - coroutineProc = coroutine; - exceptionProc = exception; - - sigbus.sa_sigaction = sigbusDespatcher; - sigbus.sa_flags = (SA_SIGINFO); - sigemptyset (&sigbus.sa_mask); - - if (sigaction (SIGBUS, &sigbus, &old) != 0) - perror ("unable to install the sigbus signal handler"); - - sigsegv.sa_sigaction = sigbusDespatcher; - sigsegv.sa_flags = (SA_SIGINFO); - sigemptyset (&sigsegv.sa_mask); - - if (sigaction (SIGSEGV, &sigsegv, &old) != 0) - perror ("unable to install the sigsegv signal handler"); - - sigfpe_.sa_sigaction = sigfpeDespatcher; - sigfpe_.sa_flags = (SA_SIGINFO); - sigemptyset (&sigfpe_.sa_mask); - - if (sigaction (SIGFPE, &sigfpe_, &old) != 0) - perror ("unable to install the sigfpe signal handler"); -} - -#else -EXTERN -void -SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef, - void *invalidloc, void *function, - void *wholevalue, void *wholediv, - void *realvalue, void *realdiv, - void *complexvalue, void *complexdiv, - void *protection, void *systemf, - void *coroutine, void *exception) -{ -} -#endif - -/* GNU Modula-2 linking fodder. */ - -EXTERN -void -_M2_SysExceptions_init (void) -{ -} - -EXTERN -void -_M2_SysExceptions_fini (void) -{ -} diff --git a/gcc/m2/pge-boot/GSysStorage.c b/gcc/m2/pge-boot/GSysStorage.c deleted file mode 100644 index d9cd60bd9fc9..000000000000 --- a/gcc/m2/pge-boot/GSysStorage.c +++ /dev/null @@ -1,249 +0,0 @@ -/* do not edit automatically generated by mc from SysStorage. */ -/* SysStorage.mod provides dynamic allocation for the system components. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -#define _SysStorage_H -#define _SysStorage_C - -# include "Glibc.h" -# include "GDebug.h" -# include "GSYSTEM.h" - -# define enableDeallocation TRUE -# define enableZero FALSE -# define enableTrace FALSE -static unsigned int callno; -static unsigned int zero; -static unsigned int trace; -extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size); -extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size); - -/* - REALLOCATE - attempts to reallocate storage. The address, - a, should either be NIL in which case ALLOCATE - is called, or alternatively it should have already - been initialized by ALLOCATE. The allocated storage - is resized accordingly. -*/ - -extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size); - -/* - REALLOCATE - attempts to reallocate storage. The address, - a, should either be NIL in which case ALLOCATE - is called, or alternatively it should have already - been initialized by ALLOCATE. The allocated storage - is resized accordingly. -*/ - -extern "C" unsigned int SysStorage_Available (unsigned int size); - -/* - Init - initializes the heap. This does nothing on a GNU/Linux system. - But it remains here since it might be used in an embedded system. -*/ - -extern "C" void SysStorage_Init (void); - -extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size) -{ - (*a) = libc_malloc (static_cast (size)); - if ((*a) == NULL) - { - Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51); - } - if (enableTrace && trace) - { - libc_printf ((const char *) " %d SysStorage.ALLOCATE (0x%x, %d bytes)\\n", 54, callno, (*a), size); - libc_printf ((const char *) " %ld %d\\n", 20, (*a), size); - callno += 1; - } -} - -extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size) -{ - if (enableTrace && trace) - { - libc_printf ((const char *) " %d SysStorage.DEALLOCATE (0x%x, %d bytes)\\n", 56, callno, (*a), size); - callno += 1; - } - if (enableZero && zero) - { - if (enableTrace && trace) - { - libc_printf ((const char *) " memset (0x%x, 0, %d bytes)\\n", 30, (*a), size); - } - if ((libc_memset ((*a), 0, static_cast (size))) != (*a)) - { - Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51); - } - } - if (enableDeallocation) - { - if (enableTrace && trace) - { - libc_printf ((const char *) " free (0x%x) %d bytes\\n", 26, (*a), size); - libc_printf ((const char *) " %ld %d\\n", 19, (*a), size); - } - libc_free ((*a)); - } - (*a) = NULL; -} - - -/* - REALLOCATE - attempts to reallocate storage. The address, - a, should either be NIL in which case ALLOCATE - is called, or alternatively it should have already - been initialized by ALLOCATE. The allocated storage - is resized accordingly. -*/ - -extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size) -{ - if ((*a) == NULL) - { - SysStorage_ALLOCATE (a, size); - } - else - { - if (enableTrace && trace) - { - libc_printf ((const char *) " %d SysStorage.REALLOCATE (0x%x, %d bytes)\\n", 56, callno, (*a), size); - callno += 1; - } - if (enableTrace && trace) - { - libc_printf ((const char *) " realloc (0x%x, %d bytes) -> ", 32, (*a), size); - libc_printf ((const char *) " %ld %d\\n", 19, (*a), size); - } - (*a) = libc_realloc ((*a), static_cast (size)); - if ((*a) == NULL) - { - Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51); - } - if (enableTrace && trace) - { - libc_printf ((const char *) " %ld %d\\n", 20, (*a), size); - libc_printf ((const char *) " 0x%x %d bytes\\n", 18, (*a), size); - } - } -} - - -/* - REALLOCATE - attempts to reallocate storage. The address, - a, should either be NIL in which case ALLOCATE - is called, or alternatively it should have already - been initialized by ALLOCATE. The allocated storage - is resized accordingly. -*/ - -extern "C" unsigned int SysStorage_Available (unsigned int size) -{ - void * a; - - if (enableTrace && trace) - { - libc_printf ((const char *) " %d SysStorage.Available (%d bytes)\\n", 49, callno, size); - callno += 1; - } - a = libc_malloc (static_cast (size)); - if (a == NULL) - { - if (enableTrace && trace) - { - libc_printf ((const char *) " no\\n", 7, size); - } - return FALSE; - } - else - { - if (enableTrace && trace) - { - libc_printf ((const char *) " yes\\n", 8, size); - } - libc_free (a); - return TRUE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - Init - initializes the heap. This does nothing on a GNU/Linux system. - But it remains here since it might be used in an embedded system. -*/ - -extern "C" void SysStorage_Init (void) -{ -} - -extern "C" void _M2_SysStorage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - callno = 0; - if (enableTrace) - { - trace = (libc_getenv (const_cast (reinterpret_cast("M2DEBUG_SYSSTORAGE_trace")))) != NULL; - } - else - { - trace = FALSE; - } - if (enableZero) - { - zero = (libc_getenv (const_cast (reinterpret_cast("M2DEBUG_SYSSTORAGE_zero")))) != NULL; - } - else - { - zero = FALSE; - } -} - -extern "C" void _M2_SysStorage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/Gabort.c b/gcc/m2/pge-boot/Gabort.c deleted file mode 100644 index 5bb34f72d57f..000000000000 --- a/gcc/m2/pge-boot/Gabort.c +++ /dev/null @@ -1,30 +0,0 @@ -/* Gabort.c a GCC style abort function. - -Copyright (C) 2022-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" - -void -fancy_abort (const char *filename, int line, const char *func) -{ - fprintf (stderr, "%s:%d%s: aborting\n", filename, line, func); - exit (1); -} diff --git a/gcc/m2/pge-boot/Gbnflex.c b/gcc/m2/pge-boot/Gbnflex.c deleted file mode 100644 index 7f78b5d250ba..000000000000 --- a/gcc/m2/pge-boot/Gbnflex.c +++ /dev/null @@ -1,602 +0,0 @@ -/* do not edit automatically generated by mc from bnflex. */ -/* bnflex.mod provides a simple lexical package for pg. - -Copyright (C) 2001-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#define _bnflex_H -#define _bnflex_C - -# include "GPushBackInput.h" -# include "GSymbolKey.h" -# include "GASCII.h" -# include "GDebug.h" -# include "GNameKey.h" -# include "GStrLib.h" -# include "GFIO.h" -# include "GStrCase.h" -# include "GStdIO.h" - -# define MaxNameLength 8192 -typedef enum {bnflex_identtok, bnflex_literaltok, bnflex_codetok, bnflex_lbecomestok, bnflex_rbecomestok, bnflex_bartok, bnflex_lsparatok, bnflex_rsparatok, bnflex_lcparatok, bnflex_rcparatok, bnflex_lparatok, bnflex_rparatok, bnflex_errortok, bnflex_tfunctok, bnflex_symfunctok, bnflex_squotetok, bnflex_dquotetok, bnflex_moduletok, bnflex_begintok, bnflex_rulestok, bnflex_endtok, bnflex_lesstok, bnflex_gretok, bnflex_tokentok, bnflex_specialtok, bnflex_firsttok, bnflex_followtok, bnflex_BNFtok, bnflex_FNBtok, bnflex_declarationtok, bnflex_epsilontok, bnflex_eoftok} bnflex_TokenType; - -static FIO_File f; -static SymbolKey_SymbolTree ReservedWords; -static NameKey_Name CurrentToken; -static bnflex_TokenType CurrentType; -static unsigned int Debugging; -static unsigned int InQuote; -static char QuoteChar; - -/* - OpenSource - Attempts to open the source file, a. - The success of the operation is returned. -*/ - -extern "C" unsigned int bnflex_OpenSource (const char *a_, unsigned int _a_high); - -/* - CloseSource - Closes the current open file. -*/ - -extern "C" void bnflex_CloseSource (void); - -/* - GetChar - returns the current character on the input stream. -*/ - -extern "C" char bnflex_GetChar (void); - -/* - PutChar - pushes a character onto the push back stack, it also - returns the character which has been pushed. -*/ - -extern "C" char bnflex_PutChar (char ch); - -/* - SymIs - if t is equal to the current token the next token is read - and true is returned, otherwise false is returned. -*/ - -extern "C" unsigned int bnflex_SymIs (bnflex_TokenType t); - -/* - IsSym - returns the result of the comparison between the current token - type and t. -*/ - -extern "C" unsigned int bnflex_IsSym (bnflex_TokenType t); - -/* - GetCurrentTokenType - returns the type of current token. -*/ - -extern "C" bnflex_TokenType bnflex_GetCurrentTokenType (void); - -/* - GetCurrentToken - returns the NameKey of the current token. -*/ - -extern "C" NameKey_Name bnflex_GetCurrentToken (void); - -/* - SkipUntilWhite - skips all characters until white space is seen. -*/ - -extern "C" void bnflex_SkipUntilWhite (void); - -/* - SkipWhite - skips all white space. -*/ - -extern "C" void bnflex_SkipWhite (void); - -/* - SkipUntilEoln - skips until a lf is seen. It consumes the lf. -*/ - -extern "C" void bnflex_SkipUntilEoln (void); - -/* - AdvanceToken - advances to the next token. -*/ - -extern "C" void bnflex_AdvanceToken (void); - -/* - IsReserved - returns TRUE if the name is a reserved word. -*/ - -extern "C" unsigned int bnflex_IsReserved (NameKey_Name name); - -/* - PushBackToken - pushes a token back onto input. -*/ - -extern "C" void bnflex_PushBackToken (NameKey_Name t); - -/* - SetDebugging - sets the debugging flag. -*/ - -extern "C" void bnflex_SetDebugging (unsigned int flag); - -/* - EatChar - consumes the next character in the input. -*/ - -static void EatChar (void); - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch); - -/* - SkipComments - consumes comments. -*/ - -static void SkipComments (void); - -/* - WriteToken - -*/ - -static void WriteToken (void); - -/* - Init - initialize the modules global variables. -*/ - -static void Init (void); - - -/* - EatChar - consumes the next character in the input. -*/ - -static void EatChar (void) -{ - if ((PushBackInput_GetCh (f)) == ASCII_nul) - {} /* empty. */ -} - - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch) -{ - return ((ch == ' ') || (ch == ASCII_tab)) || (ch == ASCII_lf); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SkipComments - consumes comments. -*/ - -static void SkipComments (void) -{ - bnflex_SkipWhite (); - while ((bnflex_PutChar (bnflex_GetChar ())) == '-') - { - if (((bnflex_GetChar ()) == '-') && ((bnflex_PutChar (bnflex_GetChar ())) == '-')) - { - /* found comment, skip it */ - bnflex_SkipUntilEoln (); - bnflex_SkipWhite (); - } - else - { - /* no second '-' found thus restore first '-' */ - if ((bnflex_PutChar ('-')) == '-') - {} /* empty. */ - return ; - } - } -} - - -/* - WriteToken - -*/ - -static void WriteToken (void) -{ - NameKey_WriteKey (CurrentToken); - StdIO_Write (' '); -} - - -/* - Init - initialize the modules global variables. -*/ - -static void Init (void) -{ - typedef struct Init__T1_a Init__T1; - - struct Init__T1_a { char array[1+1]; }; - Init__T1 a; - - SymbolKey_InitTree (&ReservedWords); - Debugging = FALSE; - a.array[0] = ASCII_nul; - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) &a.array[0], 1), ((unsigned int) (bnflex_eoftok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "%", 1), ((unsigned int) (bnflex_codetok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) ":=", 2), ((unsigned int) (bnflex_lbecomestok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "=:", 2), ((unsigned int) (bnflex_rbecomestok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "|", 1), ((unsigned int) (bnflex_bartok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "[", 1), ((unsigned int) (bnflex_lsparatok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "]", 1), ((unsigned int) (bnflex_rsparatok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "{", 1), ((unsigned int) (bnflex_lcparatok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "}", 1), ((unsigned int) (bnflex_rcparatok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "(", 1), ((unsigned int) (bnflex_lparatok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) ")", 1), ((unsigned int) (bnflex_rparatok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "<", 1), ((unsigned int) (bnflex_lesstok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) ">", 1), ((unsigned int) (bnflex_gretok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "error", 5), ((unsigned int) (bnflex_errortok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "tokenfunc", 9), ((unsigned int) (bnflex_tfunctok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "symfunc", 7), ((unsigned int) (bnflex_symfunctok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "'", 1), ((unsigned int) (bnflex_squotetok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "\"", 1), ((unsigned int) (bnflex_dquotetok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "module", 6), ((unsigned int) (bnflex_moduletok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "begin", 5), ((unsigned int) (bnflex_begintok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "rules", 5), ((unsigned int) (bnflex_rulestok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "end", 3), ((unsigned int) (bnflex_endtok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "declaration", 11), ((unsigned int) (bnflex_declarationtok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "token", 5), ((unsigned int) (bnflex_tokentok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "special", 7), ((unsigned int) (bnflex_specialtok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "first", 5), ((unsigned int) (bnflex_firsttok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "follow", 6), ((unsigned int) (bnflex_followtok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "epsilon", 7), ((unsigned int) (bnflex_epsilontok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "BNF", 3), ((unsigned int) (bnflex_BNFtok))); - SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "FNB", 3), ((unsigned int) (bnflex_FNBtok))); - CurrentToken = NameKey_NulName; - CurrentType = bnflex_identtok; - InQuote = FALSE; -} - - -/* - OpenSource - Attempts to open the source file, a. - The success of the operation is returned. -*/ - -extern "C" unsigned int bnflex_OpenSource (const char *a_, unsigned int _a_high) -{ - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - f = PushBackInput_Open ((const char *) a, _a_high); - return FIO_IsNoError (f); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CloseSource - Closes the current open file. -*/ - -extern "C" void bnflex_CloseSource (void) -{ - PushBackInput_Close (f); -} - - -/* - GetChar - returns the current character on the input stream. -*/ - -extern "C" char bnflex_GetChar (void) -{ - return PushBackInput_GetCh (f); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PutChar - pushes a character onto the push back stack, it also - returns the character which has been pushed. -*/ - -extern "C" char bnflex_PutChar (char ch) -{ - return PushBackInput_PutCh (ch); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SymIs - if t is equal to the current token the next token is read - and true is returned, otherwise false is returned. -*/ - -extern "C" unsigned int bnflex_SymIs (bnflex_TokenType t) -{ - if (CurrentType == t) - { - bnflex_AdvanceToken (); - return TRUE; - } - else - { - return FALSE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsSym - returns the result of the comparison between the current token - type and t. -*/ - -extern "C" unsigned int bnflex_IsSym (bnflex_TokenType t) -{ - return t == CurrentType; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetCurrentTokenType - returns the type of current token. -*/ - -extern "C" bnflex_TokenType bnflex_GetCurrentTokenType (void) -{ - return CurrentType; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - GetCurrentToken - returns the NameKey of the current token. -*/ - -extern "C" NameKey_Name bnflex_GetCurrentToken (void) -{ - return CurrentToken; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SkipUntilWhite - skips all characters until white space is seen. -*/ - -extern "C" void bnflex_SkipUntilWhite (void) -{ - while (((! (IsWhite (bnflex_PutChar (bnflex_GetChar ())))) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) || ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_lf)) - { - EatChar (); - } -} - - -/* - SkipWhite - skips all white space. -*/ - -extern "C" void bnflex_SkipWhite (void) -{ - while (IsWhite (bnflex_PutChar (bnflex_GetChar ()))) - { - EatChar (); - } -} - - -/* - SkipUntilEoln - skips until a lf is seen. It consumes the lf. -*/ - -extern "C" void bnflex_SkipUntilEoln (void) -{ - while (((bnflex_PutChar (bnflex_GetChar ())) != ASCII_lf) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) - { - EatChar (); - } - if ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_lf) - { - EatChar (); - } -} - - -/* - AdvanceToken - advances to the next token. -*/ - -extern "C" void bnflex_AdvanceToken (void) -{ - typedef struct AdvanceToken__T2_a AdvanceToken__T2; - - struct AdvanceToken__T2_a { char array[MaxNameLength+1]; }; - AdvanceToken__T2 a; - unsigned int i; - - i = 0; - if (InQuote) - { - if (CurrentType == bnflex_literaltok) - { - if ((bnflex_PutChar (bnflex_GetChar ())) == QuoteChar) - { - a.array[i] = bnflex_GetChar (); - InQuote = FALSE; - i += 1; - a.array[i] = ASCII_nul; - CurrentToken = NameKey_MakeKey ((const char *) &a.array[0], MaxNameLength); - CurrentType = (bnflex_TokenType) (SymbolKey_GetSymKey (ReservedWords, CurrentToken)); - } - else - { - if (QuoteChar == '"') - { - PushBackInput_WarnError ((const char *) "missing \" at the end of a literal", 33); - } - else - { - PushBackInput_WarnError ((const char *) "missing ' at the end of a literal", 33); - } - InQuote = FALSE; /* to avoid a contineous list of the same error message */ - } - } - else - { - while ((((i < MaxNameLength) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_lf)) && ((bnflex_PutChar (bnflex_GetChar ())) != QuoteChar)) - { - a.array[i] = bnflex_GetChar (); - i += 1; - } - if ((bnflex_PutChar (bnflex_GetChar ())) == QuoteChar) - { - CurrentType = bnflex_literaltok; - a.array[i] = ASCII_nul; - CurrentToken = NameKey_MakeKey ((const char *) &a.array[0], MaxNameLength); - } - else - { - if (QuoteChar == '"') - { - PushBackInput_WarnError ((const char *) "missing \" at the end of a literal", 33); - } - else - { - PushBackInput_WarnError ((const char *) "missing ' at the end of a literal", 33); - } - InQuote = FALSE; /* to avoid a contineous list of the same error message */ - } - } - } - else - { - SkipComments (); - if (((bnflex_PutChar (bnflex_GetChar ())) == '"') || ((bnflex_PutChar (bnflex_GetChar ())) == '\'')) - { - a.array[i] = bnflex_GetChar (); - QuoteChar = a.array[i]; - i += 1; - InQuote = TRUE; - a.array[i] = ASCII_nul; - CurrentToken = NameKey_MakeKey ((const char *) &a.array[0], MaxNameLength); - CurrentType = (bnflex_TokenType) (SymbolKey_GetSymKey (ReservedWords, CurrentToken)); - } - else - { - while (((((i < MaxNameLength) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_lf)) && ((bnflex_PutChar (bnflex_GetChar ())) != QuoteChar)) && (! (IsWhite (bnflex_PutChar (bnflex_GetChar ()))))) - { - a.array[i] = bnflex_GetChar (); - i += 1; - } - a.array[i] = ASCII_nul; - CurrentToken = NameKey_MakeKey ((const char *) &a.array[0], MaxNameLength); - if ((SymbolKey_GetSymKey (ReservedWords, CurrentToken)) == 0) - { - CurrentType = bnflex_identtok; - } - else - { - CurrentType = (bnflex_TokenType) (SymbolKey_GetSymKey (ReservedWords, CurrentToken)); - } - } - } - if (Debugging) - { - WriteToken (); - } -} - - -/* - IsReserved - returns TRUE if the name is a reserved word. -*/ - -extern "C" unsigned int bnflex_IsReserved (NameKey_Name name) -{ - return (SymbolKey_GetSymKey (ReservedWords, name)) != 0; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PushBackToken - pushes a token back onto input. -*/ - -extern "C" void bnflex_PushBackToken (NameKey_Name t) -{ - typedef struct PushBackToken__T3_a PushBackToken__T3; - - struct PushBackToken__T3_a { char array[MaxNameLength+1]; }; - PushBackToken__T3 a; - - NameKey_GetKey (t, (char *) &a.array[0], MaxNameLength); - PushBackInput_PutString ((const char *) &a.array[0], MaxNameLength); -} - - -/* - SetDebugging - sets the debugging flag. -*/ - -extern "C" void bnflex_SetDebugging (unsigned int flag) -{ - Debugging = flag; -} - -extern "C" void _M2_bnflex_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_bnflex_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/Gcbuiltin.c b/gcc/m2/pge-boot/Gcbuiltin.c deleted file mode 100644 index 498774ea3d05..000000000000 --- a/gcc/m2/pge-boot/Gcbuiltin.c +++ /dev/null @@ -1,173 +0,0 @@ -/* Gcbuiltin.c provides access to some math intrinsic functions. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "Gcbuiltin.h" - -#include "config.h" -#include "system.h" - -#define exp1 2.7182818284590452353602874713526624977572f - -double -cbuiltin_sqrt (double x) -{ - return sqrt (x); -} - -long double -cbuiltin_sqrtl (long double x) -{ - return sqrtl (x); -} - -float -cbuiltin_sqrtf (float x) -{ - return sqrtf (x); -} - -double -cbuiltin_exp (double x) -{ - return exp (x); -} - -float -cbuiltin_expf (float x) -{ - return expf (x); -} - -long double -cbuiltin_expl (long double x) -{ - return expl (x); -} - -/* calculcate ln from log. */ - -double -cbuiltin_ln (double x) -{ - return log (x) / log (exp1); -} - -float -cbuiltin_lnf (float x) -{ - return logf (x) / logf (exp1); -} - -long double -cbuiltin_lnl (long double x) -{ - return logl (x) / logl (exp1); -} - -double -cbuiltin_sin (double x) -{ - return sin (x); -} - -long double -cbuiltin_sinl (long double x) -{ - return sinl (x); -} - -float -cbuiltin_sinf (float x) -{ - return sinf (x); -} - -double -cbuiltin_cos (double x) -{ - return cos (x); -} - -float -cbuiltin_cosf (float x) -{ - return cosf (x); -} - -long double -cbuiltin_cosl (long double x) -{ - return cosl (x); -} - -double -cbuiltin_tan (double x) -{ - return tan (x); -} - -long double -cbuiltin_tanl (long double x) -{ - return tanl (x); -} - -float -cbuiltin_tanf (float x) -{ - return tanf (x); -} - -double -cbuiltin_arctan (double x) -{ - return atan (x); -} - -float -cbuiltin_arctanf (float x) -{ - return atanf (x); -} - -long double -arctanl (long double x) -{ - return atanl (x); -} - -int -cbuiltin_entier (double x) -{ - return (int)floor (x); -} - -int -cbuiltin_entierf (float x) -{ - return (int)floorf (x); -} - -int -cbuiltin_entierl (long double x) -{ - return (int)floorl (x); -} diff --git a/gcc/m2/pge-boot/Gdtoa.c b/gcc/m2/pge-boot/Gdtoa.c deleted file mode 100644 index a400bf80f7bb..000000000000 --- a/gcc/m2/pge-boot/Gdtoa.c +++ /dev/null @@ -1,184 +0,0 @@ -/* Gdtoa.c provides access to double string conversion. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#define GM2 - -#include "config.h" -#include "system.h" - - -#ifdef __cplusplus -extern "C" { -#endif - -#define MAX_FP_DIGITS 500 - -typedef enum Mode { maxsignicant, decimaldigits } Mode; - -/* maxsignicant: return a string containing max(1,ndigits) - significant digits. The return string contains the string - produced by ecvt. decimaldigits: return a string produced by - fcvt. The string will contain ndigits past the decimal point - (ndigits may be negative). */ - -double -dtoa_strtod (const char *s, int *error) -{ - char *endp; - double d; - - errno = 0; - d = strtod (s, &endp); - if (endp != NULL && (*endp == '\0')) - *error = (errno != 0); - else - *error = TRUE; - return d; -} - -/* dtoa_calcmaxsig - calculates the position of the decimal point it - also removes the decimal point and exponent from string, p. */ - -int -dtoa_calcmaxsig (char *p, int ndigits) -{ - char *e; - char *o; - int x; - - e = index (p, 'E'); - if (e == NULL) - x = 0; - else - { - *e = (char)0; - x = atoi (e + 1); - } - - o = index (p, '.'); - if (o == NULL) - return strlen (p) + x; - else - { - memmove (o, o + 1, ndigits - (o - p)); - return o - p + x; - } -} - -/* dtoa_calcdecimal - calculates the position of the decimal point it - also removes the decimal point and exponent from string, p. It - truncates the digits in p accordingly to ndigits. Ie ndigits is - the number of digits after the '.' */ - -int -dtoa_calcdecimal (char *p, int str_size, int ndigits) -{ - char *e; - char *o; - int x; - int l; - - e = index (p, 'E'); - if (e == NULL) - x = 0; - else - { - *e = (char)0; - x = atoi (e + 1); - } - - l = strlen (p); - o = index (p, '.'); - if (o == NULL) - x += strlen (p); - else - { - int m = strlen (o); - memmove (o, o + 1, l - (o - p)); - if (m > 0) - o[m - 1] = '0'; - x += o - p; - } - if ((x + ndigits >= 0) && (x + ndigits < str_size)) - p[x + ndigits] = (char)0; - return x; -} - - -int -dtoa_calcsign (char *p, int str_size) -{ - if (p[0] == '-') - { - memmove (p, p + 1, str_size - 1); - return TRUE; - } - else - return FALSE; -} - - -char * -dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign) -{ - char format[50]; - char *p; - int r; - switch (mode) - { - - case maxsignicant: - ndigits += 20; /* enough for exponent. */ - p = (char *) malloc (ndigits); - snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E"); - snprintf (p, ndigits, format, d); - *sign = dtoa_calcsign (p, ndigits); - *decpt = dtoa_calcmaxsig (p, ndigits); - return p; - case decimaldigits: - p = (char *) malloc (MAX_FP_DIGITS + 20); - snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E"); - snprintf (p, MAX_FP_DIGITS + 20, format, d); - *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20); - *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits); - return p; - default: - abort (); - } -} - -#if defined(GM2) -/* GNU Modula-2 hooks */ - -void -_M2_dtoa_init (void) -{ -} - -void -_M2_dtoa_finish (void) -{ -} -#endif - -#ifdef __cplusplus -} -#endif diff --git a/gcc/m2/pge-boot/Gerrno.c b/gcc/m2/pge-boot/Gerrno.c deleted file mode 100644 index c65c48630afc..000000000000 --- a/gcc/m2/pge-boot/Gerrno.c +++ /dev/null @@ -1,54 +0,0 @@ -/* Gerrno.c provides access to errno for Modula-2. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -#include "ansidecl.h" - -# ifdef __cplusplus -extern "C" { -# endif - -/* geterrno returns errno. */ - -int -errno_geterrno (void) -{ - return errno; -} - -/* init constructor for the module. */ - -void -_M2_errno_init (int argc, char *p) -{ -} - -/* finish deconstructor for the module. */ - -void -_M2_errno_fini (int argc, char *p) -{ -} - -# ifdef __cplusplus -} -# endif diff --git a/gcc/m2/pge-boot/Gldtoa.c b/gcc/m2/pge-boot/Gldtoa.c deleted file mode 100644 index 7c69535f38f6..000000000000 --- a/gcc/m2/pge-boot/Gldtoa.c +++ /dev/null @@ -1,107 +0,0 @@ -/* Gldtoa.c provides access to long double string conversion. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" - -#include "gm2-libs-host.h" - -#ifdef __cplusplus -extern "C" { -#endif - -#define MAX_FP_DIGITS 500 - -typedef enum Mode { maxsignicant, decimaldigits } Mode; - -extern int dtoa_calcmaxsig (char *p, int ndigits); -extern int dtoa_calcdecimal (char *p, int str_size, int ndigits); -extern int dtoa_calcsign (char *p, int str_size); - -/* maxsignicant: return a string containing max(1,ndigits) - significant digits. The return string contains the string - produced by snprintf. decimaldigits: return a string produced by - fcvt. The string will contain ndigits past the decimal point - (ndigits may be negative). */ - -long double -ldtoa_strtold (const char *s, int *error) -{ - char *endp; - long double d; - - errno = 0; -#if defined(HAVE_STRTOLD) - d = strtold (s, &endp); -#else - /* fall back to using strtod. */ - d = (long double)strtod (s, &endp); -#endif - if (endp != NULL && (*endp == '\0')) - *error = (errno != 0); - else - *error = TRUE; - return d; -} - -char * -ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign) -{ - char format[50]; - char *p; - int r; - switch (mode) - { - - case maxsignicant: - ndigits += 20; /* enough for exponent. */ - p = (char *)malloc (ndigits); - snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE"); - snprintf (p, ndigits, format, d); - *sign = dtoa_calcsign (p, ndigits); - *decpt = dtoa_calcmaxsig (p, ndigits); - return p; - case decimaldigits: - p = (char *)malloc (MAX_FP_DIGITS + 20); - snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE"); - snprintf (p, MAX_FP_DIGITS + 20, format, d); - *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20); - *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits); - return p; - default: - abort (); - } -} - -/* GNU Modula-2 hooks */ - -void -_M2_ldtoa_init (void) -{ -} - -void -_M2_ldtoa_finish (void) -{ -} -# ifdef __cplusplus -} -# endif diff --git a/gcc/m2/pge-boot/Glibc.c b/gcc/m2/pge-boot/Glibc.c deleted file mode 100644 index e9395651e908..000000000000 --- a/gcc/m2/pge-boot/Glibc.c +++ /dev/null @@ -1,279 +0,0 @@ -/* Glibc.c provides access to some libc functions. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" - -#if defined(__cplusplus) -#define EXTERN extern "C" -#else -#define EXTERN -#endif - -EXTERN -int -libc_read (int fd, void *a, int nbytes) -{ - return read (fd, a, nbytes); -} - -EXTERN -int -libc_write (int fd, void *a, int nbytes) -{ - return write (fd, a, nbytes); -} - -EXTERN -int -libc_close (int fd) -{ - return close (fd); -} - -EXTERN -int -libc_exit (int code) -{ - exit (code); -} - -EXTERN -void -libc_perror (char *s) -{ - perror (s); -} - -EXTERN -int -libc_abort () -{ - abort (); -} - -EXTERN -int -libc_strlen (char *s) -{ - return strlen (s); -} - -EXTERN -int -libc_printf (char *_format, unsigned int _format_high, ...) -{ - va_list arg; - int done; - char format[_format_high + 1]; - unsigned int i = 0; - unsigned int j = 0; - char *c; - - do - { - c = index (&_format[i], '\\'); - if (c == NULL) - strcpy (&format[j], &_format[i]); - else - { - memcpy (&format[j], &_format[i], (c - _format) - i); - i = c - _format; - j += c - _format; - if (_format[i + 1] == 'n') - format[j] = '\n'; - else - format[j] = _format[i + 1]; - j++; - i += 2; - } - } - while (c != NULL); - - va_start (arg, _format_high); - done = vfprintf (stdout, format, arg); - va_end (arg); - - return done; -} - -EXTERN -int -libc_snprintf (char *dest, size_t length, char *_format, unsigned int _format_high, ...) -{ - va_list arg; - int done; - char format[_format_high + 1]; - unsigned int i = 0; - unsigned int j = 0; - char *c; - - do - { - c = index (&_format[i], '\\'); - if (c == NULL) - strcpy (&format[j], &_format[i]); - else - { - memcpy (&format[j], &_format[i], (c - _format) - i); - i = c - _format; - j += c - _format; - if (_format[i + 1] == 'n') - format[j] = '\n'; - else - format[j] = _format[i + 1]; - j++; - i += 2; - } - } - while (c != NULL); - - va_start (arg, _format_high); - done = vsnprintf (dest, length, format, arg); - va_end (arg); - return done; -} - -EXTERN -void * -libc_malloc (unsigned int size) -{ - return malloc (size); -} - -EXTERN -void -libc_free (void *p) -{ - free (p); -} - -EXTERN -char * -libc_strcpy (char *dest, char *src) -{ - return strcpy (dest, src); -} - -EXTERN -char * -libc_strncpy (char *dest, char *src, int n) -{ - return strncpy (dest, src, n); -} - -EXTERN -int -libc_unlink (char *p) -{ - return unlink (p); -} - -EXTERN -int -libc_system (char *command) -{ - return system (command); -} - -EXTERN -void * -libc_memcpy (void *dest, void *src, int n) -{ - return memcpy (dest, src, n); -} - -EXTERN -char * -libc_getenv (char *name) -{ - return getenv (name); -} - -EXTERN -int -libc_putenv (char *name) -{ - return putenv (name); -} - -EXTERN -int -libc_creat (char *p, mode_t mode) -{ - return creat (p, mode); -} - -EXTERN -int -libc_open (char *p, int flags, mode_t mode) -{ - return open (p, flags, mode); -} - -EXTERN -off_t -libc_lseek (int fd, off_t offset, int whence) -{ - return lseek (fd, offset, whence); -} - -EXTERN -void * -libc_realloc (void *ptr, size_t size) -{ - return realloc (ptr, size); -} - -EXTERN -void * -libc_memset (void *s, int c, size_t n) -{ - return memset (s, c, n); -} - -EXTERN -void * -libc_memmove (void *dest, void *src, size_t n) -{ - return memmove (dest, src, n); -} - -EXTERN -int -libc_getpid (void) -{ - return getpid (); -} - -EXTERN -unsigned int -libc_sleep (unsigned int s) -{ - return sleep (s); -} - -EXTERN -int -libc_atexit (void (*function) (void)) -{ - return atexit (function); -} diff --git a/gcc/m2/pge-boot/Glibm.c b/gcc/m2/pge-boot/Glibm.c deleted file mode 100644 index 595ac4461604..000000000000 --- a/gcc/m2/pge-boot/Glibm.c +++ /dev/null @@ -1,224 +0,0 @@ -/* Glibm.c provides access to some libm functions. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#define _libm_C -#include "config.h" -#include "system.h" - -#include "Glibm.h" - -double -libm_pow (double x, double y) -{ - return pow (x, y); -} - -float -libm_powf (float x, float y) -{ - return powf (x, y); -} - -long double -libm_powl (long double x, long double y) -{ - return powl (x, y); -} - -double -libm_sqrt (double x) -{ - return sqrt (x); -} - -float -libm_sqrtf (float x) -{ - return sqrtf (x); -} - -long double -libm_sqrtl (long double x) -{ - return sqrtl (x); -} - -double -libm_asin (double x) -{ - return asin (x); -} - -float -libm_asinf (float x) -{ - return asinf (x); -} - -long double -libm_asinl (long double x) -{ - return asinl (x); -} - -double -libm_atan (double x) -{ - return atan (x); -} - -float -libm_atanf (float x) -{ - return atanf (x); -} - -long double -libm_atanl (long double x) -{ - return atanl (x); -} - -double -libm_atan2 (double x, double y) -{ - return atan2 (x, y); -} - -float -libm_atan2f (float x, float y) -{ - return atan2f (x, y); -} - -long double -libm_atan2l (long double x, long double y) -{ - return atan2l (x, y); -} - -double -libm_sin (double x) -{ - return sin (x); -} - -float -libm_sinf (float x) -{ - return sinf (x); -} - -long double -libm_sinl (long double x) -{ - return sinl (x); -} - -double -libm_cos (double x) -{ - return cos (x); -} - -float -libm_cosf (float x) -{ - return cosf (x); -} - -long double -libm_cosl (long double x) -{ - return cosl (x); -} - -double -libm_tan (double x) -{ - return tan (x); -} - -float -libm_tanf (float x) -{ - return tanf (x); -} - -long double -libm_tanl (long double x) -{ - return tanl (x); -} - -float -libm_floorf (float x) -{ - return floorf (x); -} - -double -libm_floor (double x) -{ - return floor (x); -} - -long double -libm_floorl (long double x) -{ - return floorl (x); -} - -float -libm_expf (float x) -{ - return expf (x); -} - -double -libm_exp (double x) -{ - return exp (x); -} - -long double -libm_expl (long double x) -{ - return expl (x); -} - -float -libm_logf (float x) -{ - return logf (x); -} - -double -libm_log (double x) -{ - return log (x); -} - -long double -libm_logl (long double x) -{ - return logl (x); -} diff --git a/gcc/m2/pge-boot/Gmcrts.c b/gcc/m2/pge-boot/Gmcrts.c deleted file mode 100644 index 97c9be1e1e51..000000000000 --- a/gcc/m2/pge-boot/Gmcrts.c +++ /dev/null @@ -1,54 +0,0 @@ -/* Gmcrts.c implements case and return exceptions. - -Copyright (C) 2016-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" - -# ifdef __cplusplus -extern "C" { -# endif - -void -CaseException (const char *s, unsigned int high, unsigned int lineno) -{ - fprintf (stderr, "%s:%d:case statement has no matching selection\n", s, - lineno); - _exit (1); -} - -void -ReturnException (const char *s, unsigned int high, unsigned int lineno) -{ - fprintf (stderr, "%s:%d:procedure function is about to finish and no return " - "statement has been executed\n", - s, lineno); - _exit (1); -} - -void _throw (int n) -{ - fprintf (stderr, "throw called (%d)\n", n); - _exit (1); -} - -# ifdef __cplusplus -} -# endif diff --git a/gcc/m2/pge-boot/Gpge.c b/gcc/m2/pge-boot/Gpge.c deleted file mode 100644 index e889236b9483..000000000000 --- a/gcc/m2/pge-boot/Gpge.c +++ /dev/null @@ -1,9753 +0,0 @@ -/* do not edit automatically generated by mc from pge. */ -/* pge.mod master source file of the ebnf parser generator. - -Copyright (C) 2003-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -# if !defined (PROC_D) -# define PROC_D - typedef void (*PROC_t) (void); - typedef struct { PROC_t proc; } PROC; -# endif - -# if !defined (TRUE) -# define TRUE (1==1) -# endif - -# if !defined (FALSE) -# define FALSE (1==0) -# endif - -#include -#include -#include -# include "GStorage.h" -# include "Gmcrts.h" -#if defined(__cplusplus) -# undef NULL -# define NULL 0 -#endif -# include "GPushBackInput.h" -# include "Gbnflex.h" -# include "GStrLib.h" -# include "GStorage.h" -# include "GNameKey.h" -# include "GNumberIO.h" -# include "GSymbolKey.h" -# include "GLists.h" -# include "GDynamicStrings.h" -# include "GASCII.h" -# include "GStrIO.h" -# include "GStdIO.h" -# include "GDebug.h" -# include "GArgs.h" -# include "GSYSTEM.h" -# include "Glibc.h" -# include "GOutput.h" -# include "GM2RTS.h" - -# define MaxCodeHunkLength 8192 -# define MaxFileName 8192 -# define MaxString 8192 -# define DefaultRecovery TRUE -# define MaxElementsInSet 32 -# define BaseRightLimit 75 -# define BaseRightMargin 50 -# define BaseNewLine 3 -typedef struct pge_termdesc_r pge_termdesc; - -typedef pge_termdesc *pge_TermDesc; - -typedef struct pge_DoProcedure_p pge_DoProcedure; - -typedef unsigned int pge_SetOfStop; - -typedef struct pge__T1_r pge__T1; - -typedef pge__T1 *pge_IdentDesc; - -typedef struct pge__T2_r pge__T2; - -typedef pge__T2 *pge_ProductionDesc; - -typedef struct pge__T3_r pge__T3; - -typedef pge__T3 *pge_StatementDesc; - -typedef struct pge__T4_r pge__T4; - -typedef pge__T4 *pge_ExpressionDesc; - -typedef struct pge__T5_r pge__T5; - -typedef struct pge__T6_r pge__T6; - -typedef pge__T6 *pge_FollowDesc; - -typedef struct pge__T7_r pge__T7; - -typedef pge__T7 *pge_SetDesc; - -typedef struct pge__T8_r pge__T8; - -typedef pge__T8 *pge_CodeDesc; - -typedef struct pge__T9_r pge__T9; - -typedef pge__T9 *pge_CodeHunk; - -typedef struct pge__T10_a pge__T10; - -typedef struct pge__T11_a pge__T11; - -typedef enum {pge_idel, pge_tokel, pge_litel} pge_ElementType; - -typedef enum {pge_m2none, pge_m2if, pge_m2elsif, pge_m2while} pge_m2condition; - -typedef enum {pge_unknown, pge_true, pge_false} pge_TraverseResult; - -typedef enum {pge_id, pge_lit, pge_sub, pge_opt, pge_mult, pge_m2} pge_FactorType; - -typedef pge__T5 *pge_FactorDesc; - -struct pge_termdesc_r { - pge_FactorDesc factor; - pge_TermDesc next; - pge_FollowDesc followinfo; - unsigned int line; - }; - -typedef void (*pge_DoProcedure_t) (pge_ProductionDesc); -struct pge_DoProcedure_p { pge_DoProcedure_t proc; }; - -struct pge__T1_r { - pge_ProductionDesc definition; - NameKey_Name name; - unsigned int line; - }; - -struct pge__T2_r { - pge_ProductionDesc next; - pge_StatementDesc statement; - pge_SetDesc first; - unsigned int firstsolved; - pge_FollowDesc followinfo; - unsigned int line; - NameKey_Name description; - }; - -struct pge__T3_r { - pge_IdentDesc ident; - pge_ExpressionDesc expr; - pge_FollowDesc followinfo; - unsigned int line; - }; - -struct pge__T4_r { - pge_TermDesc term; - pge_FollowDesc followinfo; - unsigned int line; - }; - -struct pge__T5_r { - pge_FollowDesc followinfo; - pge_FactorDesc next; - unsigned int line; - pge_FactorDesc pushed; - pge_FactorType type; /* case tag */ - union { - pge_IdentDesc ident; - NameKey_Name string; - pge_ExpressionDesc expr; - pge_CodeDesc code; - }; - }; - -struct pge__T6_r { - unsigned int calcfollow; - pge_SetDesc follow; - pge_TraverseResult reachend; - pge_TraverseResult epsilon; - unsigned int line; - }; - -struct pge__T7_r { - pge_SetDesc next; - pge_ElementType type; /* case tag */ - union { - pge_IdentDesc ident; - NameKey_Name string; - }; - }; - -struct pge__T8_r { - pge_CodeHunk code; - unsigned int indent; - unsigned int line; - }; - -struct pge__T10_a { char array[MaxCodeHunkLength+1]; }; -struct pge__T11_a { char array[MaxFileName+1]; }; -struct pge__T9_r { - pge__T10 codetext; - pge_CodeHunk next; - }; - -static unsigned int LastLineNo; -static unsigned int Finished; -static unsigned int SuppressFileLineTag; -static unsigned int KeywordFormatting; -static unsigned int PrettyPrint; -static unsigned int EmitCode; -static unsigned int Texinfo; -static unsigned int Sphinx; -static unsigned int FreeDocLicense; -static unsigned int Debugging; -static unsigned int WasNoError; -static unsigned int LinePrologue; -static unsigned int LineEpilogue; -static unsigned int LineDeclaration; -static pge_CodeHunk CodePrologue; -static pge_CodeHunk CodeEpilogue; -static pge_CodeHunk CodeDeclaration; -static pge_ProductionDesc CurrentProduction; -static pge_ProductionDesc TailProduction; -static pge_ProductionDesc HeadProduction; -static pge_ExpressionDesc CurrentExpression; -static pge_TermDesc CurrentTerm; -static pge_FactorDesc CurrentFactor; -static pge_IdentDesc CurrentIdent; -static pge_StatementDesc CurrentStatement; -static pge_SetDesc CurrentSetDesc; -static SymbolKey_SymbolTree ReverseValues; -static SymbolKey_SymbolTree Values; -static SymbolKey_SymbolTree ReverseAliases; -static SymbolKey_SymbolTree Aliases; -static NameKey_Name ModuleName; -static NameKey_Name LastLiteral; -static NameKey_Name LastIdent; -static NameKey_Name SymIsProc; -static NameKey_Name TokenTypeProc; -static NameKey_Name ErrorProcArray; -static NameKey_Name ErrorProcString; -static pge__T11 ArgName; -static pge__T11 FileName; -static unsigned int OnLineStart; -static unsigned int BeginningOfLine; -static unsigned int Indent; -static unsigned int EmittedVar; -static unsigned int ErrorRecovery; -static unsigned int LargestValue; -static unsigned int InitialElement; -static unsigned int ParametersUsed; - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (pge_SetOfStop stopset); - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void); - -/* - AddEntry - adds an entry into, t, containing [def:value]. -*/ - -static void AddEntry (SymbolKey_SymbolTree *t, NameKey_Name def, NameKey_Name value); - -/* - Format1 - converts string, src, into, dest, together with encapsulated - entity, n. It only formats the first %s or %d with n. -*/ - -static void Format1 (const char *src_, unsigned int _src_high, unsigned int n, char *dest, unsigned int _dest_high); - -/* - WarnError1 - -*/ - -static void WarnError1 (const char *a_, unsigned int _a_high, unsigned int n); - -/* - PrettyFollow - -*/ - -static void PrettyFollow (const char *start_, unsigned int _start_high, const char *end_, unsigned int _end_high, pge_FollowDesc f); - -/* - NewFollow - creates a new follow descriptor and returns the data structure. -*/ - -static pge_FollowDesc NewFollow (void); - -/* - AssignEpsilon - assigns the epsilon value and sets the epsilon to value, - providing condition is TRUE. -*/ - -static void AssignEpsilon (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value); - -/* - GetEpsilon - returns the value of epsilon -*/ - -static pge_TraverseResult GetEpsilon (pge_FollowDesc f); - -/* - AssignReachEnd - assigns the reachend value providing that, condition, is TRUE. -*/ - -static void AssignReachEnd (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value); - -/* - GetReachEnd - returns the value of reachend -*/ - -static pge_TraverseResult GetReachEnd (pge_FollowDesc f); - -/* - AssignFollow - assigns the follow set and sets the calcfollow to TRUE. -*/ - -static void AssignFollow (pge_FollowDesc f, pge_SetDesc s); - -/* - GetFollow - returns the follow set. -*/ - -static pge_SetDesc GetFollow (pge_FollowDesc f); - -/* - NewProduction - creates a new production and returns the data structure. -*/ - -static pge_ProductionDesc NewProduction (void); - -/* - NewFactor - -*/ - -static pge_FactorDesc NewFactor (void); - -/* - NewTerm - returns a new term. -*/ - -static pge_TermDesc NewTerm (void); - -/* - NewExpression - returns a new expression. -*/ - -static pge_ExpressionDesc NewExpression (void); - -/* - NewStatement - returns a new statement. -*/ - -static pge_StatementDesc NewStatement (void); - -/* - NewSetDesc - creates a new set description and returns the data structure. -*/ - -static pge_SetDesc NewSetDesc (void); - -/* - NewCodeDesc - creates a new code descriptor and initializes all fields to zero. -*/ - -static pge_CodeDesc NewCodeDesc (void); - -/* - CodeFragmentPrologue - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentPrologue (void); - -/* - CodeFragmentEpilogue - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentEpilogue (void); - -/* - CodeFragmentDeclaration - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentDeclaration (void); - -/* - GetCodeFragment - collects the code fragment up until ^ % -*/ - -static void GetCodeFragment (pge_CodeHunk *h); - -/* - WriteCodeHunkList - writes the CodeHunk list in the correct order. -*/ - -static void WriteCodeHunkList (pge_CodeHunk l); - -/* - WriteIndent - writes, n, spaces. -*/ - -static void WriteIndent (unsigned int n); - -/* - CheckWrite - -*/ - -static void CheckWrite (char ch, unsigned int *curpos, unsigned int left, unsigned int *seentext); - -/* - WriteStringIndent - writes a string but it will try and remove upto indent spaces - if they exist. -*/ - -static void WriteStringIndent (const char *a_, unsigned int _a_high, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext); - -/* - WriteCodeHunkListIndent - writes the CodeHunk list in the correct order - but it removes up to indent spaces if they exist. -*/ - -static void WriteCodeHunkListIndent (pge_CodeHunk l, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext); - -/* - Add - adds a character to a code hunk and creates another code hunk if necessary. -*/ - -static pge_CodeHunk Add (pge_CodeHunk *p, char ch, unsigned int *i); - -/* - ConsHunk - combine two possible code hunks. -*/ - -static void ConsHunk (pge_CodeHunk *p, pge_CodeHunk q); - -/* - GetName - returns the next symbol which is checked for a legal name. -*/ - -static NameKey_Name GetName (void); - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (pge_SetOfStop stop); - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (pge_SetOfStop stop); - -/* - Expect - -*/ - -static void Expect (bnflex_TokenType t, pge_SetOfStop stop); - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (pge_SetOfStop stop); - -/* - Modula2Code - error checking varient of Modula2Code -*/ - -static void Modula2Code (pge_SetOfStop stop); - -/* - StartModName := % ModuleName := GetName() ; ignore begintok CodeFragmentPrologue % =: -*/ - -static void StartModName (pge_SetOfStop stop); - -/* - EndModName := -*/ - -static void EndModName (pge_SetOfStop stop); - -/* - DoDeclaration := % CodeFragmentDeclaration % =: -*/ - -static void DoDeclaration (pge_SetOfStop stop); - -/* - CollectLiteral := - % LastLiteral := GetCurrentToken() ; - AdvanceToken ; % - - - first symbols:literaltok - - cannot reachend -*/ - -static void CollectLiteral (pge_SetOfStop stopset); - -/* - CollectTok := - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := tokel ; - string := GetCurrentToken() ; - END ; - IF NOT ContainsSymKey(Values, GetCurrentToken()) - THEN - AddEntry(Values, GetCurrentToken(), LargestValue) ; - AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ; - AddEntry(Aliases, GetCurrentToken(), GetCurrentToken()) ; - AddEntry(ReverseAliases, GetCurrentToken(), GetCurrentToken()) ; - INC(LargestValue) - END ; - AdvanceToken() ; % - - - first symbols:identtok - - cannot reachend -*/ - -static void CollectTok (pge_SetOfStop stopset); - -/* - DefineToken := - % AddEntry(Aliases, LastLiteral, GetCurrentToken()) ; - AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ; - AddEntry(Values, GetCurrentToken(), LargestValue) ; - AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ; - INC(LargestValue) ; - AdvanceToken ; % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefineToken (pge_SetOfStop stopset); - -/* - Rules := '%' 'rules' { Defs } ExtBNF - - first symbols:codetok - - cannot reachend -*/ - -static void Rules (pge_SetOfStop stopset); - -/* - Special := Ident - % VAR p: ProductionDesc ; % - - % p := NewProduction() ; - p^.statement := NewStatement() ; - p^.statement^.followinfo^.calcfollow := TRUE ; - p^.statement^.followinfo^.epsilon := false ; - p^.statement^.followinfo^.reachend := false ; - p^.statement^.ident := CurrentIdent ; - p^.statement^.expr := NIL ; - p^.firstsolved := TRUE ; - p^.followinfo^.calcfollow := TRUE ; - p^.followinfo^.epsilon := false ; - p^.followinfo^.reachend := false % - First Follow [ 'epsilon' - % p^.statement^.followinfo^.epsilon := true ; these are not used - but they are displayed when debugging - p^.statement^.followinfo^.reachend := true ; - p^.followinfo^.epsilon := true ; - p^.followinfo^.reachend := true - % - ] [ Literal - % p^.description := LastLiteral % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void Special (pge_SetOfStop stopset); - -/* - Factor := '%' Modula2Code '%' | - Ident - % WITH CurrentFactor^ DO - type := id ; - ident := CurrentIdent - END ; % - | Literal - % WITH CurrentFactor^ DO - type := lit ; - string := LastLiteral ; - IF GetSymKey(Aliases, LastLiteral)=NulName - THEN - WarnError1('no token defined for literal %s', LastLiteral) - END - END ; % - | '{' - % WITH CurrentFactor^ DO - type := mult ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression '}' | '[' - % WITH CurrentFactor^ DO - type := opt ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression ']' | '(' - % WITH CurrentFactor^ DO - type := sub ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression ')' - - first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok - - cannot reachend -*/ - -static void Factor (pge_SetOfStop stopset); - -/* - Statement := - % VAR i: IdentDesc ; % - Ident - % VAR p: ProductionDesc ; % - - % p := FindDefinition(CurrentIdent^.name) ; - IF p=NIL - THEN - p := NewProduction() - ELSE - IF NOT ((p^.statement=NIL) OR (p^.statement^.expr=NIL)) - THEN - WarnError1('already declared rule %s', CurrentIdent^.name) - END - END ; - i := CurrentIdent ; % - ':=' - % VAR e: ExpressionDesc ; % - - % e := NewExpression() ; - CurrentExpression := e ; % - - % VAR s: StatementDesc ; % - - % s := NewStatement() ; - WITH s^ DO - ident := i ; - expr := e - END ; % - Expression - % p^.statement := s ; % - '=:' - - first symbols:identtok - - cannot reachend -*/ - -static void Statement (pge_SetOfStop stopset); - -/* - Defs := 'special' Special | 'token' Token | - 'error' ErrorProcedures | - 'tokenfunc' TokenProcedure | - 'symfunc' SymProcedure - - first symbols:symfunctok, tfunctok, errortok, tokentok, specialtok - - cannot reachend -*/ - -static void Defs (pge_SetOfStop stopset); - -/* - ExtBNF := 'BNF' { Production } 'FNB' - - first symbols:BNFtok - - cannot reachend -*/ - -static void ExtBNF (pge_SetOfStop stopset); - -/* - Main := Header Decls Footer Rules - - first symbols:codetok - - cannot reachend -*/ - -static void Main (pge_SetOfStop stopset); - -/* - Header := '%' 'module' StartModName - - first symbols:codetok - - cannot reachend -*/ - -static void Header (pge_SetOfStop stopset); - -/* - Decls := '%' 'declaration' DoDeclaration - - first symbols:codetok - - cannot reachend -*/ - -static void Decls (pge_SetOfStop stopset); - -/* - Footer := '%' 'module' EndModName - - first symbols:codetok - - cannot reachend -*/ - -static void Footer (pge_SetOfStop stopset); - -/* - First := 'first' '{' { LitOrTokenOrIdent - % WITH CurrentSetDesc^ DO - next := TailProduction^.first ; - END ; - TailProduction^.first := CurrentSetDesc - % - } '}' - - first symbols:firsttok - - cannot reachend -*/ - -static void First (pge_SetOfStop stopset); - -/* - Follow := 'follow' '{' { LitOrTokenOrIdent - % WITH CurrentSetDesc^ DO - next := TailProduction^.followinfo^.follow ; - END ; - TailProduction^.followinfo^.follow := CurrentSetDesc - % - } '}' - - first symbols:followtok - - cannot reachend -*/ - -static void Follow (pge_SetOfStop stopset); - -/* - LitOrTokenOrIdent := Literal - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := litel ; - string := LastLiteral ; - END ; - % - | '<' CollectTok '>' | - Ident - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := idel ; - ident := CurrentIdent ; - END ; - % - - - first symbols:dquotetok, squotetok, identtok, lesstok - - cannot reachend -*/ - -static void LitOrTokenOrIdent (pge_SetOfStop stopset); - -/* - Literal := '"' CollectLiteral '"' | - "'" CollectLiteral "'" - - first symbols:squotetok, dquotetok - - cannot reachend -*/ - -static void Literal (pge_SetOfStop stopset); - -/* - Token := Literal DefineToken - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void Token (pge_SetOfStop stopset); - -/* - ErrorProcedures := Literal - % ErrorProcArray := LastLiteral % - Literal - % ErrorProcString := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void ErrorProcedures (pge_SetOfStop stopset); - -/* - TokenProcedure := Literal - % TokenTypeProc := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void TokenProcedure (pge_SetOfStop stopset); - -/* - SymProcedure := Literal - % SymIsProc := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void SymProcedure (pge_SetOfStop stopset); - -/* - Production := Statement - - first symbols:identtok - - cannot reachend -*/ - -static void Production (pge_SetOfStop stopset); - -/* - Expression := - % VAR t1, t2: TermDesc ; - e : ExpressionDesc ; % - - % e := CurrentExpression ; - t1 := NewTerm() ; - CurrentTerm := t1 ; % - Term - % e^.term := t1 ; % - { '|' - % t2 := NewTerm() ; - CurrentTerm := t2 % - Term - % t1^.next := t2 ; - t1 := t2 % - } - - first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok - - cannot reachend -*/ - -static void Expression (pge_SetOfStop stopset); - -/* - Term := - % VAR t1: TermDesc ; f1, f2: FactorDesc ; % - - % CurrentFactor := NewFactor() ; - f1 := CurrentFactor ; - t1 := CurrentTerm ; % - Factor - % t1^.factor := f1 ; - f2 := NewFactor() ; - CurrentFactor := f2 % - { Factor - % f1^.next := f2 ; - f1 := f2 ; - f2 := NewFactor() ; - CurrentFactor := f2 ; % - } - - first symbols:squotetok, dquotetok, codetok, identtok, lcparatok, lsparatok, lparatok - - cannot reachend -*/ - -static void Term (pge_SetOfStop stopset); - -/* - GetDefinitionName - returns the name of the rule inside, p. -*/ - -static NameKey_Name GetDefinitionName (pge_ProductionDesc p); - -/* - FindDefinition - searches and returns the rule which defines, n. -*/ - -static pge_ProductionDesc FindDefinition (NameKey_Name n); - -/* - BackPatchIdent - found an ident, i, we must look for the corresponding rule and - set the definition accordingly. -*/ - -static void BackPatchIdent (pge_IdentDesc i); - -/* - BackPatchFactor - runs through the factor looking for an ident -*/ - -static void BackPatchFactor (pge_FactorDesc f); - -/* - BackPatchTerm - runs through all terms to find idents. -*/ - -static void BackPatchTerm (pge_TermDesc t); - -/* - BackPatchExpression - runs through the term to find any idents. -*/ - -static void BackPatchExpression (pge_ExpressionDesc e); - -/* - BackPatchSet - -*/ - -static void BackPatchSet (pge_SetDesc s); - -/* - BackPatchIdentToDefinitions - search through all the rules and add a link from any ident - to the definition. -*/ - -static void BackPatchIdentToDefinitions (pge_ProductionDesc d); - -/* - CalculateFirstAndFollow - -*/ - -static void CalculateFirstAndFollow (pge_ProductionDesc p); - -/* - ForeachRuleDo - -*/ - -static void ForeachRuleDo (pge_DoProcedure p); - -/* - WhileNotCompleteDo - -*/ - -static void WhileNotCompleteDo (pge_DoProcedure p); - -/* - NewLine - generate a newline and indent. -*/ - -static void NewLine (unsigned int Left); - -/* - CheckNewLine - -*/ - -static void CheckNewLine (unsigned int Left); - -/* - IndentString - writes out a string with a preceeding indent. -*/ - -static void IndentString (const char *a_, unsigned int _a_high); - -/* - KeyWord - writes out a keywork with optional formatting directives. -*/ - -static void KeyWord (NameKey_Name n); - -/* - PrettyPara - -*/ - -static void PrettyPara (const char *c1_, unsigned int _c1_high, const char *c2_, unsigned int _c2_high, pge_ExpressionDesc e, unsigned int Left); - -/* - WriteKeyTexinfo - -*/ - -static void WriteKeyTexinfo (NameKey_Name s); - -/* - PrettyCommentFactor - -*/ - -static void PrettyCommentFactor (pge_FactorDesc f, unsigned int Left); - -/* - PeepTerm - returns the length of characters in term. -*/ - -static unsigned int PeepTerm (pge_TermDesc t); - -/* - PeepExpression - returns the length of the expression. -*/ - -static unsigned int PeepExpression (pge_ExpressionDesc e); - -/* - PeepFactor - returns the length of character in the factor -*/ - -static unsigned int PeepFactor (pge_FactorDesc f); - -/* - PrettyCommentTerm - -*/ - -static void PrettyCommentTerm (pge_TermDesc t, unsigned int Left); - -/* - PrettyCommentExpression - -*/ - -static void PrettyCommentExpression (pge_ExpressionDesc e, unsigned int Left); - -/* - PrettyCommentStatement - -*/ - -static void PrettyCommentStatement (pge_StatementDesc s, unsigned int Left); - -/* - PrettyCommentProduction - generates the comment for rule, p. -*/ - -static void PrettyCommentProduction (pge_ProductionDesc p); - -/* - PrettyPrintProduction - pretty prints the ebnf rule, p. -*/ - -static void PrettyPrintProduction (pge_ProductionDesc p); - -/* - EmitFileLineTag - emits a line and file tag using the C preprocessor syntax. -*/ - -static void EmitFileLineTag (unsigned int line); - -/* - EmitRule - generates a comment and code for rule, p. -*/ - -static void EmitRule (pge_ProductionDesc p); - -/* - CodeCondition - -*/ - -static void CodeCondition (pge_m2condition m); - -/* - CodeThenDo - codes a "THEN" or "DO" depending upon, m. -*/ - -static void CodeThenDo (pge_m2condition m); - -/* - CodeElseEnd - builds an ELSE END statement using string, end. -*/ - -static void CodeElseEnd (const char *end_, unsigned int _end_high, unsigned int consumed, pge_FactorDesc f, unsigned int inopt); - -/* - CodeEnd - codes a "END" depending upon, m. -*/ - -static void CodeEnd (pge_m2condition m, pge_TermDesc t, unsigned int consumed, pge_FactorDesc f, unsigned int inopt); - -/* - EmitNonVarCode - writes out, code, providing it is not a variable declaration. -*/ - -static void EmitNonVarCode (pge_CodeDesc code, unsigned int curpos, unsigned int left); - -/* - ChainOn - -*/ - -static pge_FactorDesc ChainOn (pge_FactorDesc codeStack, pge_FactorDesc f); - -/* - FlushCode - -*/ - -static void FlushCode (pge_FactorDesc *codeStack); - -/* - CodeFactor - -*/ - -static void CodeFactor (pge_FactorDesc f, pge_TermDesc t, pge_m2condition l, pge_m2condition n, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack); - -/* - CodeTerm - -*/ - -static void CodeTerm (pge_TermDesc t, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack); - -/* - CodeExpression - -*/ - -static void CodeExpression (pge_ExpressionDesc e, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack); - -/* - CodeStatement - -*/ - -static void CodeStatement (pge_StatementDesc s, pge_m2condition m); - -/* - CodeProduction - only encode grammer rules which are not special. -*/ - -static void CodeProduction (pge_ProductionDesc p); - -/* - RecoverCondition - -*/ - -static void RecoverCondition (pge_m2condition m); - -/* - ConditionIndent - returns the number of spaces indentation created via, m. -*/ - -static unsigned int ConditionIndent (pge_m2condition m); - -/* - WriteGetTokenType - writes out the method of determining the token type. -*/ - -static void WriteGetTokenType (void); - -/* - NumberOfElements - returns the number of elements in set, to, which lie between low..high -*/ - -static unsigned int NumberOfElements (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - WriteElement - writes the literal name for element, e. -*/ - -static void WriteElement (unsigned int e); - -/* - EmitIsInSet - writes out the equivalent of GetTokenType() IN { toset } -*/ - -static void EmitIsInSet (pge_SetDesc to, NameKey_Name low, NameKey_Name high); - -/* - EmitIsInSubSet - writes out a test to see whether GetTokenype() is in { subset } -*/ - -static void EmitIsInSubSet (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - EmitIsInFirst - -*/ - -static void EmitIsInFirst (pge_SetDesc to, pge_m2condition m); -static void FlushRecoverCode (pge_FactorDesc *codeStack); - -/* - RecoverFactor - -*/ - -static void RecoverFactor (pge_FactorDesc f, pge_m2condition m, pge_FactorDesc codeStack); - -/* - OptExpSeen - returns TRUE if we can see an optional expression in the factor. - This is not the same as epsilon. Example { '+' } matches epsilon as - well as { '+' | '-' } but OptExpSeen returns TRUE in the second case - and FALSE in the first. -*/ - -static unsigned int OptExpSeen (pge_FactorDesc f); - -/* - RecoverTerm - -*/ - -static void RecoverTerm (pge_TermDesc t, pge_m2condition new_, pge_m2condition old); - -/* - RecoverExpression - -*/ - -static void RecoverExpression (pge_ExpressionDesc e, pge_m2condition new_, pge_m2condition old); - -/* - RecoverStatement - -*/ - -static void RecoverStatement (pge_StatementDesc s, pge_m2condition m); - -/* - EmitFirstFactor - generate a list of all first tokens between the range: low..high. -*/ - -static void EmitFirstFactor (pge_FactorDesc f, unsigned int low, unsigned int high); - -/* - EmitUsed - -*/ - -static void EmitUsed (unsigned int wordno); - -/* - EmitStopParameters - generate the stop set. -*/ - -static void EmitStopParameters (unsigned int FormalParameters); - -/* - IsBetween - returns TRUE if the value of the token, string, is - in the range: low..high -*/ - -static unsigned int IsBetween (NameKey_Name string, unsigned int low, unsigned int high); - -/* - IsEmptySet - returns TRUE if no elements exist in set, to, with values, low..high. -*/ - -static unsigned int IsEmptySet (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - EmitSet - emits the tokens in the set, to, which have values low..high -*/ - -static void EmitSet (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - EmitSetName - emits the tokens in the set, to, which have values low..high, using - their names. -*/ - -static void EmitSetName (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - EmitStopParametersAndSet - generates the stop parameters together with a set - inclusion of all the symbols in set, to. -*/ - -static void EmitStopParametersAndSet (pge_SetDesc to); - -/* - EmitSetAsParameters - generates the first symbols as parameters to a set function. -*/ - -static void EmitSetAsParameters (pge_SetDesc to); - -/* - EmitStopParametersAndFollow - generates the stop parameters together with a set - inclusion of all the follow symbols for subsequent - sentances. -*/ - -static void EmitStopParametersAndFollow (pge_FactorDesc f, pge_m2condition m); - -/* - EmitFirstAsParameters - -*/ - -static void EmitFirstAsParameters (pge_FactorDesc f); - -/* - RecoverProduction - only encode grammer rules which are not special. - Generate error recovery code. -*/ - -static void RecoverProduction (pge_ProductionDesc p); - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch); - -/* - FindStr - returns TRUE if, str, was seen inside the code hunk -*/ - -static unsigned int FindStr (pge_CodeHunk *code, unsigned int *i, const char *str_, unsigned int _str_high); - -/* - WriteUpto - -*/ - -static void WriteUpto (pge_CodeHunk code, pge_CodeHunk upto, unsigned int limit); - -/* - CheckForVar - checks for any local variables which need to be emitted during - this production. -*/ - -static void CheckForVar (pge_CodeHunk code); - -/* - VarFactor - -*/ - -static void VarFactor (pge_FactorDesc f); - -/* - VarTerm - -*/ - -static void VarTerm (pge_TermDesc t); - -/* - VarExpression - -*/ - -static void VarExpression (pge_ExpressionDesc e); - -/* - VarStatement - -*/ - -static void VarStatement (pge_StatementDesc s); - -/* - VarProduction - writes out all variable declarations. -*/ - -static void VarProduction (pge_ProductionDesc p); - -/* - In - returns TRUE if token, s, is already in the set, to. -*/ - -static unsigned int In (pge_SetDesc to, NameKey_Name s); - -/* - IntersectionIsNil - given two set lists, s1, s2, return TRUE if the - s1 * s2 = {} -*/ - -static unsigned int IntersectionIsNil (pge_SetDesc s1, pge_SetDesc s2); - -/* - AddSet - adds a first symbol to a production. -*/ - -static void AddSet (pge_SetDesc *to, NameKey_Name s); - -/* - OrSet - -*/ - -static void OrSet (pge_SetDesc *to, pge_SetDesc from); - -/* - CalcFirstFactor - -*/ - -static void CalcFirstFactor (pge_FactorDesc f, pge_ProductionDesc from, pge_SetDesc *to); - -/* - CalcFirstTerm - -*/ - -static void CalcFirstTerm (pge_TermDesc t, pge_ProductionDesc from, pge_SetDesc *to); - -/* - CalcFirstExpression - -*/ - -static void CalcFirstExpression (pge_ExpressionDesc e, pge_ProductionDesc from, pge_SetDesc *to); - -/* - CalcFirstStatement - -*/ - -static void CalcFirstStatement (pge_StatementDesc s, pge_ProductionDesc from, pge_SetDesc *to); - -/* - CalcFirstProduction - calculates all of the first symbols for the grammer -*/ - -static void CalcFirstProduction (pge_ProductionDesc p, pge_ProductionDesc from, pge_SetDesc *to); -static void WorkOutFollowFactor (pge_FactorDesc f, pge_SetDesc *followset, pge_SetDesc after); - -/* - WorkOutFollowTerm - -*/ - -static void WorkOutFollowTerm (pge_TermDesc t, pge_SetDesc *followset, pge_SetDesc after); - -/* - WorkOutFollowExpression - -*/ - -static void WorkOutFollowExpression (pge_ExpressionDesc e, pge_SetDesc *followset, pge_SetDesc after); - -/* - CollectFollow - collects the follow set from, f, into, to. -*/ - -static void CollectFollow (pge_SetDesc *to, pge_FollowDesc f); - -/* - CalcFollowFactor - -*/ - -static void CalcFollowFactor (pge_FactorDesc f, pge_SetDesc after); - -/* - CalcFollowTerm - -*/ - -static void CalcFollowTerm (pge_TermDesc t, pge_SetDesc after); - -/* - CalcFollowExpression - -*/ - -static void CalcFollowExpression (pge_ExpressionDesc e, pge_SetDesc after); - -/* - CalcFollowStatement - given a bnf statement generate the follow set. -*/ - -static void CalcFollowStatement (pge_StatementDesc s); - -/* - CalcFollowProduction - -*/ - -static void CalcFollowProduction (pge_ProductionDesc p); - -/* - CalcEpsilonFactor - -*/ - -static void CalcEpsilonFactor (pge_FactorDesc f); - -/* - CalcEpsilonTerm - -*/ - -static void CalcEpsilonTerm (pge_TermDesc t); - -/* - CalcEpsilonExpression - -*/ - -static void CalcEpsilonExpression (pge_ExpressionDesc e); - -/* - CalcEpsilonStatement - given a bnf statement generate the follow set. -*/ - -static void CalcEpsilonStatement (pge_StatementDesc s); - -/* - CalcEpsilonProduction - -*/ - -static void CalcEpsilonProduction (pge_ProductionDesc p); - -/* - CalcReachEndFactor - -*/ - -static pge_TraverseResult CalcReachEndFactor (pge_FactorDesc f); - -/* - CalcReachEndTerm - -*/ - -static pge_TraverseResult CalcReachEndTerm (pge_TermDesc t); - -/* - CalcReachEndExpression - -*/ - -static void CalcReachEndExpression (pge_ExpressionDesc e); - -/* - CalcReachEndStatement - -*/ - -static void CalcReachEndStatement (pge_StatementDesc s); - -/* - CalcReachEndStatement - -*/ - -static void stop (void); - -/* - CalcReachEndProduction - -*/ - -static void CalcReachEndProduction (pge_ProductionDesc p); - -/* - EmptyFactor - -*/ - -static unsigned int EmptyFactor (pge_FactorDesc f); - -/* - EmptyTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int EmptyTerm (pge_TermDesc t); - -/* - EmptyExpression - -*/ - -static unsigned int EmptyExpression (pge_ExpressionDesc e); - -/* - EmptyStatement - returns TRUE if statement, s, is empty. -*/ - -static unsigned int EmptyStatement (pge_StatementDesc s); - -/* - EmptyProduction - returns if production, p, maybe empty. -*/ - -static unsigned int EmptyProduction (pge_ProductionDesc p); - -/* - EmitFDLNotice - -*/ - -static void EmitFDLNotice (void); - -/* - EmitRules - generates the BNF rules. -*/ - -static void EmitRules (void); - -/* - DescribeElement - -*/ - -static void DescribeElement (unsigned int name); - -/* - EmitInTestStop - construct a test for stop element, name. -*/ - -static void EmitInTestStop (NameKey_Name name); - -/* - DescribeStopElement - -*/ - -static void DescribeStopElement (unsigned int name); - -/* - EmitDescribeStop - -*/ - -static void EmitDescribeStop (void); - -/* - EmitDescribeError - -*/ - -static void EmitDescribeError (void); - -/* - EmitSetTypes - write out the set types used during error recovery -*/ - -static void EmitSetTypes (void); - -/* - EmitSupport - generates the support routines. -*/ - -static void EmitSupport (void); - -/* - DisposeSetDesc - dispose of the set list, s. -*/ - -static void DisposeSetDesc (pge_SetDesc *s); - -/* - OptionalFactor - -*/ - -static unsigned int OptionalFactor (pge_FactorDesc f); - -/* - OptionalTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int OptionalTerm (pge_TermDesc t); - -/* - OptionalExpression - -*/ - -static unsigned int OptionalExpression (pge_ExpressionDesc e); - -/* - OptionalStatement - returns FALSE if statement, s, does not have a optional ambiguity. -*/ - -static unsigned int OptionalStatement (pge_StatementDesc s); - -/* - OptionalProduction - -*/ - -static unsigned int OptionalProduction (pge_ProductionDesc p); - -/* - CheckFirstFollow - -*/ - -static unsigned int CheckFirstFollow (pge_FactorDesc f, pge_FactorDesc after); - -/* - ConstrainedEmptyFactor - -*/ - -static unsigned int ConstrainedEmptyFactor (pge_FactorDesc f); - -/* - ConstrainedEmptyTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int ConstrainedEmptyTerm (pge_TermDesc t); - -/* - ConstrainedEmptyExpression - -*/ - -static unsigned int ConstrainedEmptyExpression (pge_ExpressionDesc e); - -/* - ConstrainedEmptyStatement - returns FALSE if statement, s, does not have a optional ambiguity. -*/ - -static unsigned int ConstrainedEmptyStatement (pge_StatementDesc s); - -/* - ConstrainedEmptyProduction - returns TRUE if a problem exists with, p. -*/ - -static unsigned int ConstrainedEmptyProduction (pge_ProductionDesc p); - -/* - TestForLALR1 - -*/ - -static void TestForLALR1 (pge_ProductionDesc p); - -/* - DoEpsilon - runs the epsilon interrelated rules -*/ - -static void DoEpsilon (pge_ProductionDesc p); - -/* - CheckComplete - checks that production, p, is complete. -*/ - -static void CheckComplete (pge_ProductionDesc p); - -/* - PostProcessRules - backpatch the ident to rule definitions and emit comments and code. -*/ - -static void PostProcessRules (void); - -/* - DisplayHelp - display a summary help and then exit (0). -*/ - -static void DisplayHelp (void); - -/* - ParseArgs - -*/ - -static void ParseArgs (void); - -/* - Init - initialize the modules data structures -*/ - -static void Init (void); - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (pge_SetOfStop stopset); - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void); - -/* - AddEntry - adds an entry into, t, containing [def:value]. -*/ - -static void AddEntry (SymbolKey_SymbolTree *t, NameKey_Name def, NameKey_Name value); - -/* - Format1 - converts string, src, into, dest, together with encapsulated - entity, n. It only formats the first %s or %d with n. -*/ - -static void Format1 (const char *src_, unsigned int _src_high, unsigned int n, char *dest, unsigned int _dest_high); - -/* - WarnError1 - -*/ - -static void WarnError1 (const char *a_, unsigned int _a_high, unsigned int n); - -/* - PrettyFollow - -*/ - -static void PrettyFollow (const char *start_, unsigned int _start_high, const char *end_, unsigned int _end_high, pge_FollowDesc f); - -/* - NewFollow - creates a new follow descriptor and returns the data structure. -*/ - -static pge_FollowDesc NewFollow (void); - -/* - AssignEpsilon - assigns the epsilon value and sets the epsilon to value, - providing condition is TRUE. -*/ - -static void AssignEpsilon (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value); - -/* - GetEpsilon - returns the value of epsilon -*/ - -static pge_TraverseResult GetEpsilon (pge_FollowDesc f); - -/* - AssignReachEnd - assigns the reachend value providing that, condition, is TRUE. -*/ - -static void AssignReachEnd (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value); - -/* - GetReachEnd - returns the value of reachend -*/ - -static pge_TraverseResult GetReachEnd (pge_FollowDesc f); - -/* - AssignFollow - assigns the follow set and sets the calcfollow to TRUE. -*/ - -static void AssignFollow (pge_FollowDesc f, pge_SetDesc s); - -/* - GetFollow - returns the follow set. -*/ - -static pge_SetDesc GetFollow (pge_FollowDesc f); - -/* - NewProduction - creates a new production and returns the data structure. -*/ - -static pge_ProductionDesc NewProduction (void); - -/* - NewFactor - -*/ - -static pge_FactorDesc NewFactor (void); - -/* - NewTerm - returns a new term. -*/ - -static pge_TermDesc NewTerm (void); - -/* - NewExpression - returns a new expression. -*/ - -static pge_ExpressionDesc NewExpression (void); - -/* - NewStatement - returns a new statement. -*/ - -static pge_StatementDesc NewStatement (void); - -/* - NewSetDesc - creates a new set description and returns the data structure. -*/ - -static pge_SetDesc NewSetDesc (void); - -/* - NewCodeDesc - creates a new code descriptor and initializes all fields to zero. -*/ - -static pge_CodeDesc NewCodeDesc (void); - -/* - CodeFragmentPrologue - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentPrologue (void); - -/* - CodeFragmentEpilogue - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentEpilogue (void); - -/* - CodeFragmentDeclaration - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentDeclaration (void); - -/* - GetCodeFragment - collects the code fragment up until ^ % -*/ - -static void GetCodeFragment (pge_CodeHunk *h); - -/* - WriteCodeHunkList - writes the CodeHunk list in the correct order. -*/ - -static void WriteCodeHunkList (pge_CodeHunk l); - -/* - WriteIndent - writes, n, spaces. -*/ - -static void WriteIndent (unsigned int n); - -/* - CheckWrite - -*/ - -static void CheckWrite (char ch, unsigned int *curpos, unsigned int left, unsigned int *seentext); - -/* - WriteStringIndent - writes a string but it will try and remove upto indent spaces - if they exist. -*/ - -static void WriteStringIndent (const char *a_, unsigned int _a_high, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext); - -/* - WriteCodeHunkListIndent - writes the CodeHunk list in the correct order - but it removes up to indent spaces if they exist. -*/ - -static void WriteCodeHunkListIndent (pge_CodeHunk l, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext); - -/* - Add - adds a character to a code hunk and creates another code hunk if necessary. -*/ - -static pge_CodeHunk Add (pge_CodeHunk *p, char ch, unsigned int *i); - -/* - ConsHunk - combine two possible code hunks. -*/ - -static void ConsHunk (pge_CodeHunk *p, pge_CodeHunk q); - -/* - GetName - returns the next symbol which is checked for a legal name. -*/ - -static NameKey_Name GetName (void); - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (pge_SetOfStop stop); - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (pge_SetOfStop stop); - -/* - Expect - -*/ - -static void Expect (bnflex_TokenType t, pge_SetOfStop stop); - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (pge_SetOfStop stop); - -/* - Modula2Code - error checking varient of Modula2Code -*/ - -static void Modula2Code (pge_SetOfStop stop); - -/* - StartModName := % ModuleName := GetName() ; ignore begintok CodeFragmentPrologue % =: -*/ - -static void StartModName (pge_SetOfStop stop); - -/* - EndModName := -*/ - -static void EndModName (pge_SetOfStop stop); - -/* - DoDeclaration := % CodeFragmentDeclaration % =: -*/ - -static void DoDeclaration (pge_SetOfStop stop); - -/* - CollectLiteral := - % LastLiteral := GetCurrentToken() ; - AdvanceToken ; % - - - first symbols:literaltok - - cannot reachend -*/ - -static void CollectLiteral (pge_SetOfStop stopset); - -/* - CollectTok := - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := tokel ; - string := GetCurrentToken() ; - END ; - IF NOT ContainsSymKey(Values, GetCurrentToken()) - THEN - AddEntry(Values, GetCurrentToken(), LargestValue) ; - AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ; - AddEntry(Aliases, GetCurrentToken(), GetCurrentToken()) ; - AddEntry(ReverseAliases, GetCurrentToken(), GetCurrentToken()) ; - INC(LargestValue) - END ; - AdvanceToken() ; % - - - first symbols:identtok - - cannot reachend -*/ - -static void CollectTok (pge_SetOfStop stopset); - -/* - DefineToken := - % AddEntry(Aliases, LastLiteral, GetCurrentToken()) ; - AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ; - AddEntry(Values, GetCurrentToken(), LargestValue) ; - AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ; - INC(LargestValue) ; - AdvanceToken ; % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefineToken (pge_SetOfStop stopset); - -/* - Rules := '%' 'rules' { Defs } ExtBNF - - first symbols:codetok - - cannot reachend -*/ - -static void Rules (pge_SetOfStop stopset); - -/* - Special := Ident - % VAR p: ProductionDesc ; % - - % p := NewProduction() ; - p^.statement := NewStatement() ; - p^.statement^.followinfo^.calcfollow := TRUE ; - p^.statement^.followinfo^.epsilon := false ; - p^.statement^.followinfo^.reachend := false ; - p^.statement^.ident := CurrentIdent ; - p^.statement^.expr := NIL ; - p^.firstsolved := TRUE ; - p^.followinfo^.calcfollow := TRUE ; - p^.followinfo^.epsilon := false ; - p^.followinfo^.reachend := false % - First Follow [ 'epsilon' - % p^.statement^.followinfo^.epsilon := true ; these are not used - but they are displayed when debugging - p^.statement^.followinfo^.reachend := true ; - p^.followinfo^.epsilon := true ; - p^.followinfo^.reachend := true - % - ] [ Literal - % p^.description := LastLiteral % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void Special (pge_SetOfStop stopset); - -/* - Factor := '%' Modula2Code '%' | - Ident - % WITH CurrentFactor^ DO - type := id ; - ident := CurrentIdent - END ; % - | Literal - % WITH CurrentFactor^ DO - type := lit ; - string := LastLiteral ; - IF GetSymKey(Aliases, LastLiteral)=NulName - THEN - WarnError1('no token defined for literal %s', LastLiteral) - END - END ; % - | '{' - % WITH CurrentFactor^ DO - type := mult ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression '}' | '[' - % WITH CurrentFactor^ DO - type := opt ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression ']' | '(' - % WITH CurrentFactor^ DO - type := sub ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression ')' - - first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok - - cannot reachend -*/ - -static void Factor (pge_SetOfStop stopset); - -/* - Statement := - % VAR i: IdentDesc ; % - Ident - % VAR p: ProductionDesc ; % - - % p := FindDefinition(CurrentIdent^.name) ; - IF p=NIL - THEN - p := NewProduction() - ELSE - IF NOT ((p^.statement=NIL) OR (p^.statement^.expr=NIL)) - THEN - WarnError1('already declared rule %s', CurrentIdent^.name) - END - END ; - i := CurrentIdent ; % - ':=' - % VAR e: ExpressionDesc ; % - - % e := NewExpression() ; - CurrentExpression := e ; % - - % VAR s: StatementDesc ; % - - % s := NewStatement() ; - WITH s^ DO - ident := i ; - expr := e - END ; % - Expression - % p^.statement := s ; % - '=:' - - first symbols:identtok - - cannot reachend -*/ - -static void Statement (pge_SetOfStop stopset); - -/* - Defs := 'special' Special | 'token' Token | - 'error' ErrorProcedures | - 'tokenfunc' TokenProcedure | - 'symfunc' SymProcedure - - first symbols:symfunctok, tfunctok, errortok, tokentok, specialtok - - cannot reachend -*/ - -static void Defs (pge_SetOfStop stopset); - -/* - ExtBNF := 'BNF' { Production } 'FNB' - - first symbols:BNFtok - - cannot reachend -*/ - -static void ExtBNF (pge_SetOfStop stopset); - -/* - Main := Header Decls Footer Rules - - first symbols:codetok - - cannot reachend -*/ - -static void Main (pge_SetOfStop stopset); - -/* - Header := '%' 'module' StartModName - - first symbols:codetok - - cannot reachend -*/ - -static void Header (pge_SetOfStop stopset); - -/* - Decls := '%' 'declaration' DoDeclaration - - first symbols:codetok - - cannot reachend -*/ - -static void Decls (pge_SetOfStop stopset); - -/* - Footer := '%' 'module' EndModName - - first symbols:codetok - - cannot reachend -*/ - -static void Footer (pge_SetOfStop stopset); - -/* - First := 'first' '{' { LitOrTokenOrIdent - % WITH CurrentSetDesc^ DO - next := TailProduction^.first ; - END ; - TailProduction^.first := CurrentSetDesc - % - } '}' - - first symbols:firsttok - - cannot reachend -*/ - -static void First (pge_SetOfStop stopset); - -/* - Follow := 'follow' '{' { LitOrTokenOrIdent - % WITH CurrentSetDesc^ DO - next := TailProduction^.followinfo^.follow ; - END ; - TailProduction^.followinfo^.follow := CurrentSetDesc - % - } '}' - - first symbols:followtok - - cannot reachend -*/ - -static void Follow (pge_SetOfStop stopset); - -/* - LitOrTokenOrIdent := Literal - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := litel ; - string := LastLiteral ; - END ; - % - | '<' CollectTok '>' | - Ident - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := idel ; - ident := CurrentIdent ; - END ; - % - - - first symbols:dquotetok, squotetok, identtok, lesstok - - cannot reachend -*/ - -static void LitOrTokenOrIdent (pge_SetOfStop stopset); - -/* - Literal := '"' CollectLiteral '"' | - "'" CollectLiteral "'" - - first symbols:squotetok, dquotetok - - cannot reachend -*/ - -static void Literal (pge_SetOfStop stopset); - -/* - Token := Literal DefineToken - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void Token (pge_SetOfStop stopset); - -/* - ErrorProcedures := Literal - % ErrorProcArray := LastLiteral % - Literal - % ErrorProcString := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void ErrorProcedures (pge_SetOfStop stopset); - -/* - TokenProcedure := Literal - % TokenTypeProc := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void TokenProcedure (pge_SetOfStop stopset); - -/* - SymProcedure := Literal - % SymIsProc := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void SymProcedure (pge_SetOfStop stopset); - -/* - Production := Statement - - first symbols:identtok - - cannot reachend -*/ - -static void Production (pge_SetOfStop stopset); - -/* - Expression := - % VAR t1, t2: TermDesc ; - e : ExpressionDesc ; % - - % e := CurrentExpression ; - t1 := NewTerm() ; - CurrentTerm := t1 ; % - Term - % e^.term := t1 ; % - { '|' - % t2 := NewTerm() ; - CurrentTerm := t2 % - Term - % t1^.next := t2 ; - t1 := t2 % - } - - first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok - - cannot reachend -*/ - -static void Expression (pge_SetOfStop stopset); - -/* - Term := - % VAR t1: TermDesc ; f1, f2: FactorDesc ; % - - % CurrentFactor := NewFactor() ; - f1 := CurrentFactor ; - t1 := CurrentTerm ; % - Factor - % t1^.factor := f1 ; - f2 := NewFactor() ; - CurrentFactor := f2 % - { Factor - % f1^.next := f2 ; - f1 := f2 ; - f2 := NewFactor() ; - CurrentFactor := f2 ; % - } - - first symbols:squotetok, dquotetok, codetok, identtok, lcparatok, lsparatok, lparatok - - cannot reachend -*/ - -static void Term (pge_SetOfStop stopset); - -/* - GetDefinitionName - returns the name of the rule inside, p. -*/ - -static NameKey_Name GetDefinitionName (pge_ProductionDesc p); - -/* - FindDefinition - searches and returns the rule which defines, n. -*/ - -static pge_ProductionDesc FindDefinition (NameKey_Name n); - -/* - BackPatchIdent - found an ident, i, we must look for the corresponding rule and - set the definition accordingly. -*/ - -static void BackPatchIdent (pge_IdentDesc i); - -/* - BackPatchFactor - runs through the factor looking for an ident -*/ - -static void BackPatchFactor (pge_FactorDesc f); - -/* - BackPatchTerm - runs through all terms to find idents. -*/ - -static void BackPatchTerm (pge_TermDesc t); - -/* - BackPatchExpression - runs through the term to find any idents. -*/ - -static void BackPatchExpression (pge_ExpressionDesc e); - -/* - BackPatchSet - -*/ - -static void BackPatchSet (pge_SetDesc s); - -/* - BackPatchIdentToDefinitions - search through all the rules and add a link from any ident - to the definition. -*/ - -static void BackPatchIdentToDefinitions (pge_ProductionDesc d); - -/* - CalculateFirstAndFollow - -*/ - -static void CalculateFirstAndFollow (pge_ProductionDesc p); - -/* - ForeachRuleDo - -*/ - -static void ForeachRuleDo (pge_DoProcedure p); - -/* - WhileNotCompleteDo - -*/ - -static void WhileNotCompleteDo (pge_DoProcedure p); - -/* - NewLine - generate a newline and indent. -*/ - -static void NewLine (unsigned int Left); - -/* - CheckNewLine - -*/ - -static void CheckNewLine (unsigned int Left); - -/* - IndentString - writes out a string with a preceeding indent. -*/ - -static void IndentString (const char *a_, unsigned int _a_high); - -/* - KeyWord - writes out a keywork with optional formatting directives. -*/ - -static void KeyWord (NameKey_Name n); - -/* - PrettyPara - -*/ - -static void PrettyPara (const char *c1_, unsigned int _c1_high, const char *c2_, unsigned int _c2_high, pge_ExpressionDesc e, unsigned int Left); - -/* - WriteKeyTexinfo - -*/ - -static void WriteKeyTexinfo (NameKey_Name s); - -/* - PrettyCommentFactor - -*/ - -static void PrettyCommentFactor (pge_FactorDesc f, unsigned int Left); - -/* - PeepTerm - returns the length of characters in term. -*/ - -static unsigned int PeepTerm (pge_TermDesc t); - -/* - PeepExpression - returns the length of the expression. -*/ - -static unsigned int PeepExpression (pge_ExpressionDesc e); - -/* - PeepFactor - returns the length of character in the factor -*/ - -static unsigned int PeepFactor (pge_FactorDesc f); - -/* - PrettyCommentTerm - -*/ - -static void PrettyCommentTerm (pge_TermDesc t, unsigned int Left); - -/* - PrettyCommentExpression - -*/ - -static void PrettyCommentExpression (pge_ExpressionDesc e, unsigned int Left); - -/* - PrettyCommentStatement - -*/ - -static void PrettyCommentStatement (pge_StatementDesc s, unsigned int Left); - -/* - PrettyCommentProduction - generates the comment for rule, p. -*/ - -static void PrettyCommentProduction (pge_ProductionDesc p); - -/* - PrettyPrintProduction - pretty prints the ebnf rule, p. -*/ - -static void PrettyPrintProduction (pge_ProductionDesc p); - -/* - EmitFileLineTag - emits a line and file tag using the C preprocessor syntax. -*/ - -static void EmitFileLineTag (unsigned int line); - -/* - EmitRule - generates a comment and code for rule, p. -*/ - -static void EmitRule (pge_ProductionDesc p); - -/* - CodeCondition - -*/ - -static void CodeCondition (pge_m2condition m); - -/* - CodeThenDo - codes a "THEN" or "DO" depending upon, m. -*/ - -static void CodeThenDo (pge_m2condition m); - -/* - CodeElseEnd - builds an ELSE END statement using string, end. -*/ - -static void CodeElseEnd (const char *end_, unsigned int _end_high, unsigned int consumed, pge_FactorDesc f, unsigned int inopt); - -/* - CodeEnd - codes a "END" depending upon, m. -*/ - -static void CodeEnd (pge_m2condition m, pge_TermDesc t, unsigned int consumed, pge_FactorDesc f, unsigned int inopt); - -/* - EmitNonVarCode - writes out, code, providing it is not a variable declaration. -*/ - -static void EmitNonVarCode (pge_CodeDesc code, unsigned int curpos, unsigned int left); - -/* - ChainOn - -*/ - -static pge_FactorDesc ChainOn (pge_FactorDesc codeStack, pge_FactorDesc f); - -/* - FlushCode - -*/ - -static void FlushCode (pge_FactorDesc *codeStack); - -/* - CodeFactor - -*/ - -static void CodeFactor (pge_FactorDesc f, pge_TermDesc t, pge_m2condition l, pge_m2condition n, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack); - -/* - CodeTerm - -*/ - -static void CodeTerm (pge_TermDesc t, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack); - -/* - CodeExpression - -*/ - -static void CodeExpression (pge_ExpressionDesc e, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack); - -/* - CodeStatement - -*/ - -static void CodeStatement (pge_StatementDesc s, pge_m2condition m); - -/* - CodeProduction - only encode grammer rules which are not special. -*/ - -static void CodeProduction (pge_ProductionDesc p); - -/* - RecoverCondition - -*/ - -static void RecoverCondition (pge_m2condition m); - -/* - ConditionIndent - returns the number of spaces indentation created via, m. -*/ - -static unsigned int ConditionIndent (pge_m2condition m); - -/* - WriteGetTokenType - writes out the method of determining the token type. -*/ - -static void WriteGetTokenType (void); - -/* - NumberOfElements - returns the number of elements in set, to, which lie between low..high -*/ - -static unsigned int NumberOfElements (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - WriteElement - writes the literal name for element, e. -*/ - -static void WriteElement (unsigned int e); - -/* - EmitIsInSet - writes out the equivalent of GetTokenType() IN { toset } -*/ - -static void EmitIsInSet (pge_SetDesc to, NameKey_Name low, NameKey_Name high); - -/* - EmitIsInSubSet - writes out a test to see whether GetTokenype() is in { subset } -*/ - -static void EmitIsInSubSet (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - EmitIsInFirst - -*/ - -static void EmitIsInFirst (pge_SetDesc to, pge_m2condition m); -static void FlushRecoverCode (pge_FactorDesc *codeStack); - -/* - RecoverFactor - -*/ - -static void RecoverFactor (pge_FactorDesc f, pge_m2condition m, pge_FactorDesc codeStack); - -/* - OptExpSeen - returns TRUE if we can see an optional expression in the factor. - This is not the same as epsilon. Example { '+' } matches epsilon as - well as { '+' | '-' } but OptExpSeen returns TRUE in the second case - and FALSE in the first. -*/ - -static unsigned int OptExpSeen (pge_FactorDesc f); - -/* - RecoverTerm - -*/ - -static void RecoverTerm (pge_TermDesc t, pge_m2condition new_, pge_m2condition old); - -/* - RecoverExpression - -*/ - -static void RecoverExpression (pge_ExpressionDesc e, pge_m2condition new_, pge_m2condition old); - -/* - RecoverStatement - -*/ - -static void RecoverStatement (pge_StatementDesc s, pge_m2condition m); - -/* - EmitFirstFactor - generate a list of all first tokens between the range: low..high. -*/ - -static void EmitFirstFactor (pge_FactorDesc f, unsigned int low, unsigned int high); - -/* - EmitUsed - -*/ - -static void EmitUsed (unsigned int wordno); - -/* - EmitStopParameters - generate the stop set. -*/ - -static void EmitStopParameters (unsigned int FormalParameters); - -/* - IsBetween - returns TRUE if the value of the token, string, is - in the range: low..high -*/ - -static unsigned int IsBetween (NameKey_Name string, unsigned int low, unsigned int high); - -/* - IsEmptySet - returns TRUE if no elements exist in set, to, with values, low..high. -*/ - -static unsigned int IsEmptySet (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - EmitSet - emits the tokens in the set, to, which have values low..high -*/ - -static void EmitSet (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - EmitSetName - emits the tokens in the set, to, which have values low..high, using - their names. -*/ - -static void EmitSetName (pge_SetDesc to, unsigned int low, unsigned int high); - -/* - EmitStopParametersAndSet - generates the stop parameters together with a set - inclusion of all the symbols in set, to. -*/ - -static void EmitStopParametersAndSet (pge_SetDesc to); - -/* - EmitSetAsParameters - generates the first symbols as parameters to a set function. -*/ - -static void EmitSetAsParameters (pge_SetDesc to); - -/* - EmitStopParametersAndFollow - generates the stop parameters together with a set - inclusion of all the follow symbols for subsequent - sentances. -*/ - -static void EmitStopParametersAndFollow (pge_FactorDesc f, pge_m2condition m); - -/* - EmitFirstAsParameters - -*/ - -static void EmitFirstAsParameters (pge_FactorDesc f); - -/* - RecoverProduction - only encode grammer rules which are not special. - Generate error recovery code. -*/ - -static void RecoverProduction (pge_ProductionDesc p); - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch); - -/* - FindStr - returns TRUE if, str, was seen inside the code hunk -*/ - -static unsigned int FindStr (pge_CodeHunk *code, unsigned int *i, const char *str_, unsigned int _str_high); - -/* - WriteUpto - -*/ - -static void WriteUpto (pge_CodeHunk code, pge_CodeHunk upto, unsigned int limit); - -/* - CheckForVar - checks for any local variables which need to be emitted during - this production. -*/ - -static void CheckForVar (pge_CodeHunk code); - -/* - VarFactor - -*/ - -static void VarFactor (pge_FactorDesc f); - -/* - VarTerm - -*/ - -static void VarTerm (pge_TermDesc t); - -/* - VarExpression - -*/ - -static void VarExpression (pge_ExpressionDesc e); - -/* - VarStatement - -*/ - -static void VarStatement (pge_StatementDesc s); - -/* - VarProduction - writes out all variable declarations. -*/ - -static void VarProduction (pge_ProductionDesc p); - -/* - In - returns TRUE if token, s, is already in the set, to. -*/ - -static unsigned int In (pge_SetDesc to, NameKey_Name s); - -/* - IntersectionIsNil - given two set lists, s1, s2, return TRUE if the - s1 * s2 = {} -*/ - -static unsigned int IntersectionIsNil (pge_SetDesc s1, pge_SetDesc s2); - -/* - AddSet - adds a first symbol to a production. -*/ - -static void AddSet (pge_SetDesc *to, NameKey_Name s); - -/* - OrSet - -*/ - -static void OrSet (pge_SetDesc *to, pge_SetDesc from); - -/* - CalcFirstFactor - -*/ - -static void CalcFirstFactor (pge_FactorDesc f, pge_ProductionDesc from, pge_SetDesc *to); - -/* - CalcFirstTerm - -*/ - -static void CalcFirstTerm (pge_TermDesc t, pge_ProductionDesc from, pge_SetDesc *to); - -/* - CalcFirstExpression - -*/ - -static void CalcFirstExpression (pge_ExpressionDesc e, pge_ProductionDesc from, pge_SetDesc *to); - -/* - CalcFirstStatement - -*/ - -static void CalcFirstStatement (pge_StatementDesc s, pge_ProductionDesc from, pge_SetDesc *to); - -/* - CalcFirstProduction - calculates all of the first symbols for the grammer -*/ - -static void CalcFirstProduction (pge_ProductionDesc p, pge_ProductionDesc from, pge_SetDesc *to); -static void WorkOutFollowFactor (pge_FactorDesc f, pge_SetDesc *followset, pge_SetDesc after); - -/* - WorkOutFollowTerm - -*/ - -static void WorkOutFollowTerm (pge_TermDesc t, pge_SetDesc *followset, pge_SetDesc after); - -/* - WorkOutFollowExpression - -*/ - -static void WorkOutFollowExpression (pge_ExpressionDesc e, pge_SetDesc *followset, pge_SetDesc after); - -/* - CollectFollow - collects the follow set from, f, into, to. -*/ - -static void CollectFollow (pge_SetDesc *to, pge_FollowDesc f); - -/* - CalcFollowFactor - -*/ - -static void CalcFollowFactor (pge_FactorDesc f, pge_SetDesc after); - -/* - CalcFollowTerm - -*/ - -static void CalcFollowTerm (pge_TermDesc t, pge_SetDesc after); - -/* - CalcFollowExpression - -*/ - -static void CalcFollowExpression (pge_ExpressionDesc e, pge_SetDesc after); - -/* - CalcFollowStatement - given a bnf statement generate the follow set. -*/ - -static void CalcFollowStatement (pge_StatementDesc s); - -/* - CalcFollowProduction - -*/ - -static void CalcFollowProduction (pge_ProductionDesc p); - -/* - CalcEpsilonFactor - -*/ - -static void CalcEpsilonFactor (pge_FactorDesc f); - -/* - CalcEpsilonTerm - -*/ - -static void CalcEpsilonTerm (pge_TermDesc t); - -/* - CalcEpsilonExpression - -*/ - -static void CalcEpsilonExpression (pge_ExpressionDesc e); - -/* - CalcEpsilonStatement - given a bnf statement generate the follow set. -*/ - -static void CalcEpsilonStatement (pge_StatementDesc s); - -/* - CalcEpsilonProduction - -*/ - -static void CalcEpsilonProduction (pge_ProductionDesc p); - -/* - CalcReachEndFactor - -*/ - -static pge_TraverseResult CalcReachEndFactor (pge_FactorDesc f); - -/* - CalcReachEndTerm - -*/ - -static pge_TraverseResult CalcReachEndTerm (pge_TermDesc t); - -/* - CalcReachEndExpression - -*/ - -static void CalcReachEndExpression (pge_ExpressionDesc e); - -/* - CalcReachEndStatement - -*/ - -static void CalcReachEndStatement (pge_StatementDesc s); - -/* - CalcReachEndStatement - -*/ - -static void stop (void); - -/* - CalcReachEndProduction - -*/ - -static void CalcReachEndProduction (pge_ProductionDesc p); - -/* - EmptyFactor - -*/ - -static unsigned int EmptyFactor (pge_FactorDesc f); - -/* - EmptyTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int EmptyTerm (pge_TermDesc t); - -/* - EmptyExpression - -*/ - -static unsigned int EmptyExpression (pge_ExpressionDesc e); - -/* - EmptyStatement - returns TRUE if statement, s, is empty. -*/ - -static unsigned int EmptyStatement (pge_StatementDesc s); - -/* - EmptyProduction - returns if production, p, maybe empty. -*/ - -static unsigned int EmptyProduction (pge_ProductionDesc p); - -/* - EmitFDLNotice - -*/ - -static void EmitFDLNotice (void); - -/* - EmitRules - generates the BNF rules. -*/ - -static void EmitRules (void); - -/* - DescribeElement - -*/ - -static void DescribeElement (unsigned int name); - -/* - EmitInTestStop - construct a test for stop element, name. -*/ - -static void EmitInTestStop (NameKey_Name name); - -/* - DescribeStopElement - -*/ - -static void DescribeStopElement (unsigned int name); - -/* - EmitDescribeStop - -*/ - -static void EmitDescribeStop (void); - -/* - EmitDescribeError - -*/ - -static void EmitDescribeError (void); - -/* - EmitSetTypes - write out the set types used during error recovery -*/ - -static void EmitSetTypes (void); - -/* - EmitSupport - generates the support routines. -*/ - -static void EmitSupport (void); - -/* - DisposeSetDesc - dispose of the set list, s. -*/ - -static void DisposeSetDesc (pge_SetDesc *s); - -/* - OptionalFactor - -*/ - -static unsigned int OptionalFactor (pge_FactorDesc f); - -/* - OptionalTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int OptionalTerm (pge_TermDesc t); - -/* - OptionalExpression - -*/ - -static unsigned int OptionalExpression (pge_ExpressionDesc e); - -/* - OptionalStatement - returns FALSE if statement, s, does not have a optional ambiguity. -*/ - -static unsigned int OptionalStatement (pge_StatementDesc s); - -/* - OptionalProduction - -*/ - -static unsigned int OptionalProduction (pge_ProductionDesc p); - -/* - CheckFirstFollow - -*/ - -static unsigned int CheckFirstFollow (pge_FactorDesc f, pge_FactorDesc after); - -/* - ConstrainedEmptyFactor - -*/ - -static unsigned int ConstrainedEmptyFactor (pge_FactorDesc f); - -/* - ConstrainedEmptyTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int ConstrainedEmptyTerm (pge_TermDesc t); - -/* - ConstrainedEmptyExpression - -*/ - -static unsigned int ConstrainedEmptyExpression (pge_ExpressionDesc e); - -/* - ConstrainedEmptyStatement - returns FALSE if statement, s, does not have a optional ambiguity. -*/ - -static unsigned int ConstrainedEmptyStatement (pge_StatementDesc s); - -/* - ConstrainedEmptyProduction - returns TRUE if a problem exists with, p. -*/ - -static unsigned int ConstrainedEmptyProduction (pge_ProductionDesc p); - -/* - TestForLALR1 - -*/ - -static void TestForLALR1 (pge_ProductionDesc p); - -/* - DoEpsilon - runs the epsilon interrelated rules -*/ - -static void DoEpsilon (pge_ProductionDesc p); - -/* - CheckComplete - checks that production, p, is complete. -*/ - -static void CheckComplete (pge_ProductionDesc p); - -/* - PostProcessRules - backpatch the ident to rule definitions and emit comments and code. -*/ - -static void PostProcessRules (void); - -/* - DisplayHelp - display a summary help and then exit (0). -*/ - -static void DisplayHelp (void); - -/* - ParseArgs - -*/ - -static void ParseArgs (void); - -/* - Init - initialize the modules data structures -*/ - -static void Init (void); - - -/* - DescribeStop - issues a message explaining what tokens were expected -*/ - -static DynamicStrings_String DescribeStop (pge_SetOfStop stopset) -{ - unsigned int n; - DynamicStrings_String str; - DynamicStrings_String message; - - n = 0; - message = DynamicStrings_InitString ((const char *) "", 0); - if ((((1 << (bnflex_literaltok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "literal", 7))); - n += 1; - } - if ((((1 << (bnflex_identtok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10))); - n += 1; - } - if ((((1 << (bnflex_FNBtok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FNB", 3))); - n += 1; - } - if ((((1 << (bnflex_BNFtok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BNF", 3))); - n += 1; - } - if ((((1 << (bnflex_epsilontok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "epsilon", 7))); - n += 1; - } - if ((((1 << (bnflex_followtok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "follow", 6))); - n += 1; - } - if ((((1 << (bnflex_firsttok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "first", 5))); - n += 1; - } - if ((((1 << (bnflex_specialtok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "special", 7))); - n += 1; - } - if ((((1 << (bnflex_tokentok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "token", 5))); - n += 1; - } - if ((((1 << (bnflex_declarationtok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "declaration", 11))); - n += 1; - } - if ((((1 << (bnflex_endtok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "end", 3))); - n += 1; - } - if ((((1 << (bnflex_rulestok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "rules", 5))); - n += 1; - } - if ((((1 << (bnflex_begintok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "begin", 5))); - n += 1; - } - if ((((1 << (bnflex_moduletok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "module", 6))); - n += 1; - } - if ((((1 << (bnflex_dquotetok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ','); - n += 1; - } - if ((((1 << (bnflex_squotetok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ','); - n += 1; - } - if ((((1 << (bnflex_symfunctok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "symfunc", 7))); - n += 1; - } - if ((((1 << (bnflex_tfunctok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "tokenfunc", 9))); - n += 1; - } - if ((((1 << (bnflex_errortok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "error", 5))); - n += 1; - } - if ((((1 << (bnflex_gretok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1))); - n += 1; - } - if ((((1 << (bnflex_lesstok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1))); - n += 1; - } - if ((((1 << (bnflex_rparatok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1))); - n += 1; - } - if ((((1 << (bnflex_lparatok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1))); - n += 1; - } - if ((((1 << (bnflex_rcparatok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1))); - n += 1; - } - if ((((1 << (bnflex_lcparatok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1))); - n += 1; - } - if ((((1 << (bnflex_rsparatok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1))); - n += 1; - } - if ((((1 << (bnflex_lsparatok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1))); - n += 1; - } - if ((((1 << (bnflex_bartok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1))); - n += 1; - } - if ((((1 << (bnflex_rbecomestok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=:", 2))); - n += 1; - } - if ((((1 << (bnflex_lbecomestok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2))); - n += 1; - } - if ((((1 << (bnflex_codetok-bnflex_identtok)) & (stopset)) != 0)) - { - message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%", 1))); - n += 1; - } - if ((((1 << (bnflex_eoftok-bnflex_identtok)) & (stopset)) != 0)) - {} /* empty. */ - /* eoftok has no token name (needed to generate error messages) */ - if (n == 0) - { - str = DynamicStrings_InitString ((const char *) " syntax error", 13); - message = DynamicStrings_KillString (message); - } - else if (n == 1) - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9))); - } - else - { - /* avoid dangling else. */ - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message); - message = DynamicStrings_KillString (message); - } - return str; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - DescribeError - issues a message explaining what tokens were expected -*/ - -static void DescribeError (void) -{ - DynamicStrings_String str; - - str = DynamicStrings_InitString ((const char *) "", 0); - switch (bnflex_GetCurrentTokenType ()) - { - case bnflex_literaltok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found literal", 27), DynamicStrings_Mark (str)); - break; - - case bnflex_identtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str)); - break; - - case bnflex_FNBtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FNB", 23), DynamicStrings_Mark (str)); - break; - - case bnflex_BNFtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BNF", 23), DynamicStrings_Mark (str)); - break; - - case bnflex_epsilontok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found epsilon", 27), DynamicStrings_Mark (str)); - break; - - case bnflex_followtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found follow", 26), DynamicStrings_Mark (str)); - break; - - case bnflex_firsttok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found first", 25), DynamicStrings_Mark (str)); - break; - - case bnflex_specialtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found special", 27), DynamicStrings_Mark (str)); - break; - - case bnflex_tokentok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found token", 25), DynamicStrings_Mark (str)); - break; - - case bnflex_declarationtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found declaration", 31), DynamicStrings_Mark (str)); - break; - - case bnflex_endtok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found end", 23), DynamicStrings_Mark (str)); - break; - - case bnflex_rulestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found rules", 25), DynamicStrings_Mark (str)); - break; - - case bnflex_begintok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found begin", 25), DynamicStrings_Mark (str)); - break; - - case bnflex_moduletok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found module", 26), DynamicStrings_Mark (str)); - break; - - case bnflex_dquotetok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str)); - break; - - case bnflex_squotetok: - str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str)); - break; - - case bnflex_symfunctok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found symfunc", 27), DynamicStrings_Mark (str)); - break; - - case bnflex_tfunctok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found tokenfunc", 29), DynamicStrings_Mark (str)); - break; - - case bnflex_errortok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found error", 25), DynamicStrings_Mark (str)); - break; - - case bnflex_gretok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_lesstok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_rparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_lparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_rcparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_lcparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_rsparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_lsparatok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_bartok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_rbecomestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =:", 22), DynamicStrings_Mark (str)); - break; - - case bnflex_lbecomestok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str)); - break; - - case bnflex_codetok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found %", 21), DynamicStrings_Mark (str)); - break; - - case bnflex_eoftok: - str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str)); - break; - - - default: - break; - } - PushBackInput_WarnString (str); -} - - -/* - AddEntry - adds an entry into, t, containing [def:value]. -*/ - -static void AddEntry (SymbolKey_SymbolTree *t, NameKey_Name def, NameKey_Name value) -{ - if (SymbolKey_ContainsSymKey ((*t), def)) - { - WarnError1 ((const char *) "already seen a definition for token '%s'", 40, def); - } - else - { - SymbolKey_PutSymKey ((*t), def, value); - } -} - - -/* - Format1 - converts string, src, into, dest, together with encapsulated - entity, n. It only formats the first %s or %d with n. -*/ - -static void Format1 (const char *src_, unsigned int _src_high, unsigned int n, char *dest, unsigned int _dest_high) -{ - typedef struct Format1__T12_a Format1__T12; - - struct Format1__T12_a { char array[MaxString+1]; }; - unsigned int HighSrc; - unsigned int HighDest; - unsigned int i; - unsigned int j; - Format1__T12 str; - char src[_src_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (src, src_, _src_high+1); - - HighSrc = StrLib_StrLen ((const char *) src, _src_high); - HighDest = _dest_high; - i = 0; - j = 0; - while ((((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) && (src[i] != '%')) - { - dest[j] = src[i]; - i += 1; - j += 1; - } - if ((((i+1) < HighSrc) && (src[i] == '%')) && (j < HighDest)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (src[i+1] == 's') - { - dest[j] = ASCII_nul; - NameKey_GetKey (n, (char *) &str.array[0], MaxString); - StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxString, (char *) dest, _dest_high); - j = StrLib_StrLen ((const char *) dest, _dest_high); - i += 2; - } - else if (src[i+1] == 'd') - { - /* avoid dangling else. */ - dest[j] = ASCII_nul; - NumberIO_CardToStr (n, 0, (char *) &str.array[0], MaxString); - StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxString, (char *) dest, _dest_high); - j = StrLib_StrLen ((const char *) dest, _dest_high); - i += 2; - } - else - { - /* avoid dangling else. */ - dest[j] = src[i]; - i += 1; - j += 1; - } - } - /* and finish off copying src into dest */ - while (((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) - { - dest[j] = src[i]; - i += 1; - j += 1; - } - if (j < HighDest) - { - dest[j] = ASCII_nul; - } -} - - -/* - WarnError1 - -*/ - -static void WarnError1 (const char *a_, unsigned int _a_high, unsigned int n) -{ - typedef struct WarnError1__T13_a WarnError1__T13; - - struct WarnError1__T13_a { char array[MaxString+1]; }; - WarnError1__T13 line; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - Format1 ((const char *) a, _a_high, n, (char *) &line.array[0], MaxString); - PushBackInput_WarnError ((const char *) &line.array[0], MaxString); -} - - -/* - PrettyFollow - -*/ - -static void PrettyFollow (const char *start_, unsigned int _start_high, const char *end_, unsigned int _end_high, pge_FollowDesc f) -{ - char start[_start_high+1]; - char end[_end_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (start, start_, _start_high+1); - memcpy (end, end_, _end_high+1); - - if (Debugging) - { - Output_WriteString ((const char *) start, _start_high); - if (f != NULL) - { - if (f->calcfollow) - { - Output_WriteString ((const char *) "followset defined as:", 21); - EmitSet (f->follow, static_cast (0), static_cast (0)); - } - switch (f->reachend) - { - case pge_true: - Output_WriteString ((const char *) " [E]", 4); - break; - - case pge_false: - Output_WriteString ((const char *) " [C]", 4); - break; - - case pge_unknown: - Output_WriteString ((const char *) " [U]", 4); - break; - - - default: - break; - } - switch (f->epsilon) - { - case pge_true: - Output_WriteString ((const char *) " [e]", 4); - break; - - case pge_false: - break; - - case pge_unknown: - Output_WriteString ((const char *) " [u]", 4); - break; - - - default: - break; - } - } - Output_WriteString ((const char *) end, _end_high); - } -} - - -/* - NewFollow - creates a new follow descriptor and returns the data structure. -*/ - -static pge_FollowDesc NewFollow (void) -{ - pge_FollowDesc f; - - Storage_ALLOCATE ((void **) &f, sizeof (pge__T6)); - f->follow = NULL; - f->reachend = pge_unknown; - f->epsilon = pge_unknown; - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - AssignEpsilon - assigns the epsilon value and sets the epsilon to value, - providing condition is TRUE. -*/ - -static void AssignEpsilon (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value) -{ - if ((condition && (value != pge_unknown)) && (f->epsilon == pge_unknown)) - { - f->epsilon = value; - Finished = FALSE; - } -} - - -/* - GetEpsilon - returns the value of epsilon -*/ - -static pge_TraverseResult GetEpsilon (pge_FollowDesc f) -{ - if (f == NULL) - { - Debug_Halt ((const char *) "why is the follow info NIL?", 27, 596, (const char *) "m2/gm2-auto/pge.mod", 19); - } - else - { - return f->epsilon; - } - ReturnException ("m2/gm2-auto/pge.mod", 1, 7); - __builtin_unreachable (); -} - - -/* - AssignReachEnd - assigns the reachend value providing that, condition, is TRUE. -*/ - -static void AssignReachEnd (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value) -{ - if (condition) - { - if ((f->reachend == pge_unknown) && (value != pge_unknown)) - { - f->reachend = value; - Finished = FALSE; - } - } -} - - -/* - GetReachEnd - returns the value of reachend -*/ - -static pge_TraverseResult GetReachEnd (pge_FollowDesc f) -{ - if (f == NULL) - { - Debug_Halt ((const char *) "why is the follow info NIL?", 27, 630, (const char *) "m2/gm2-auto/pge.mod", 19); - } - else - { - return f->reachend; - } - ReturnException ("m2/gm2-auto/pge.mod", 1, 7); - __builtin_unreachable (); -} - - -/* - AssignFollow - assigns the follow set and sets the calcfollow to TRUE. -*/ - -static void AssignFollow (pge_FollowDesc f, pge_SetDesc s) -{ - if (f->calcfollow) - { - Debug_Halt ((const char *) "why are we reassigning this follow set?", 39, 646, (const char *) "m2/gm2-auto/pge.mod", 19); - } - f->follow = s; - f->calcfollow = TRUE; -} - - -/* - GetFollow - returns the follow set. -*/ - -static pge_SetDesc GetFollow (pge_FollowDesc f) -{ - if (f == NULL) - { - Debug_Halt ((const char *) "why is the follow info NIL?", 27, 662, (const char *) "m2/gm2-auto/pge.mod", 19); - } - else - { - if (f->calcfollow) - { - return f->follow; - } - else - { - Debug_Halt ((const char *) "not calculated the follow set yet..", 35, 669, (const char *) "m2/gm2-auto/pge.mod", 19); - } - } - ReturnException ("m2/gm2-auto/pge.mod", 1, 7); - __builtin_unreachable (); -} - - -/* - NewProduction - creates a new production and returns the data structure. -*/ - -static pge_ProductionDesc NewProduction (void) -{ - pge_ProductionDesc p; - - Storage_ALLOCATE ((void **) &p, sizeof (pge__T2)); - if (TailProduction != NULL) - { - TailProduction->next = p; - } - TailProduction = p; - if (HeadProduction == NULL) - { - HeadProduction = p; - } - p->next = NULL; - p->statement = NULL; - p->first = NULL; - p->firstsolved = FALSE; - p->followinfo = NewFollow (); - p->line = PushBackInput_GetCurrentLine (); - p->description = NameKey_NulName; - return p; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NewFactor - -*/ - -static pge_FactorDesc NewFactor (void) -{ - pge_FactorDesc f; - - Storage_ALLOCATE ((void **) &f, sizeof (pge__T5)); - f->next = NULL; - f->followinfo = NewFollow (); - f->line = PushBackInput_GetCurrentLine (); - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NewTerm - returns a new term. -*/ - -static pge_TermDesc NewTerm (void) -{ - pge_TermDesc t; - - Storage_ALLOCATE ((void **) &t, sizeof (pge_termdesc)); - t->factor = NULL; - t->followinfo = NewFollow (); - t->next = NULL; - t->line = PushBackInput_GetCurrentLine (); - return t; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NewExpression - returns a new expression. -*/ - -static pge_ExpressionDesc NewExpression (void) -{ - pge_ExpressionDesc e; - - Storage_ALLOCATE ((void **) &e, sizeof (pge__T4)); - e->term = NULL; - e->followinfo = NewFollow (); - e->line = PushBackInput_GetCurrentLine (); - return e; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NewStatement - returns a new statement. -*/ - -static pge_StatementDesc NewStatement (void) -{ - pge_StatementDesc s; - - Storage_ALLOCATE ((void **) &s, sizeof (pge__T3)); - s->ident = NULL; - s->expr = NULL; - s->followinfo = NewFollow (); - s->line = PushBackInput_GetCurrentLine (); - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NewSetDesc - creates a new set description and returns the data structure. -*/ - -static pge_SetDesc NewSetDesc (void) -{ - pge_SetDesc s; - - Storage_ALLOCATE ((void **) &s, sizeof (pge__T7)); - s->next = NULL; - return s; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - NewCodeDesc - creates a new code descriptor and initializes all fields to zero. -*/ - -static pge_CodeDesc NewCodeDesc (void) -{ - pge_CodeDesc c; - - Storage_ALLOCATE ((void **) &c, sizeof (pge__T8)); - c->code = NULL; - c->indent = 0; - c->line = PushBackInput_GetCurrentLine (); - return c; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CodeFragmentPrologue - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentPrologue (void) -{ - LinePrologue = PushBackInput_GetCurrentLine (); - GetCodeFragment (&CodePrologue); -} - - -/* - CodeFragmentEpilogue - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentEpilogue (void) -{ - LineEpilogue = PushBackInput_GetCurrentLine (); - GetCodeFragment (&CodeEpilogue); -} - - -/* - CodeFragmentDeclaration - consumes code text up to a "%" after a newline. -*/ - -static void CodeFragmentDeclaration (void) -{ - LineDeclaration = PushBackInput_GetCurrentLine (); - GetCodeFragment (&CodeDeclaration); -} - - -/* - GetCodeFragment - collects the code fragment up until ^ % -*/ - -static void GetCodeFragment (pge_CodeHunk *h) -{ - unsigned int i; - char ch; - - (*h) = NULL; - i = 0; - while (((bnflex_PutChar (bnflex_GetChar ())) != '%') && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) - { - do { - while (((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_lf)) - { - (*h) = Add (h, bnflex_GetChar (), &i); - } - if ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_lf) - { - /* consume line feed */ - (*h) = Add (h, bnflex_GetChar (), &i); - ch = bnflex_PutChar (ASCII_lf); - } - else if ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_nul) - { - /* avoid dangling else. */ - ch = bnflex_PutChar (ASCII_nul); - ch = bnflex_PutChar (ASCII_lf); - } - else - { - /* avoid dangling else. */ - ch = bnflex_PutChar (bnflex_PutChar (bnflex_GetChar ())); - } - } while (! ((bnflex_GetChar ()) == ASCII_lf)); - } - if ((bnflex_PutChar (bnflex_GetChar ())) == '%') - { - (*h) = Add (h, ASCII_nul, &i); - ch = bnflex_PutChar (' '); /* to give the following token % a delimiter infront of it */ - bnflex_AdvanceToken (); /* to give the following token % a delimiter infront of it */ - } - else - { - PushBackInput_WarnError ((const char *) "expecting % to terminate code fragment, found end of file", 57); - } -} - - -/* - WriteCodeHunkList - writes the CodeHunk list in the correct order. -*/ - -static void WriteCodeHunkList (pge_CodeHunk l) -{ - if (l != NULL) - { - OnLineStart = FALSE; - /* recursion */ - WriteCodeHunkList (l->next); - Output_WriteString ((const char *) &l->codetext.array[0], MaxCodeHunkLength); - } -} - - -/* - WriteIndent - writes, n, spaces. -*/ - -static void WriteIndent (unsigned int n) -{ - while (n > 0) - { - Output_Write (' '); - n -= 1; - } - OnLineStart = FALSE; -} - - -/* - CheckWrite - -*/ - -static void CheckWrite (char ch, unsigned int *curpos, unsigned int left, unsigned int *seentext) -{ - if (ch == ASCII_lf) - { - NewLine (left); - (*curpos) = 0; - (*seentext) = FALSE; - } - else - { - Output_Write (ch); - (*curpos) += 1; - } -} - - -/* - WriteStringIndent - writes a string but it will try and remove upto indent spaces - if they exist. -*/ - -static void WriteStringIndent (const char *a_, unsigned int _a_high, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext) -{ - unsigned int l; - unsigned int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = 0; - l = StrLib_StrLen ((const char *) a, _a_high); - while (i < l) - { - if ((*seentext)) - { - CheckWrite (a[i], curpos, left, seentext); - } - else - { - if (a[i] == ' ') - { - /* ignore space for now */ - (*curpos) += 1; - } - else - { - if ((*curpos) >= indent) - { - WriteIndent ((*curpos)-indent); - } - (*seentext) = TRUE; - CheckWrite (a[i], curpos, left, seentext); - } - } - i += 1; - } -} - - -/* - WriteCodeHunkListIndent - writes the CodeHunk list in the correct order - but it removes up to indent spaces if they exist. -*/ - -static void WriteCodeHunkListIndent (pge_CodeHunk l, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext) -{ - if (l != NULL) - { - /* recursion */ - WriteCodeHunkListIndent (l->next, indent, curpos, left, seentext); - WriteStringIndent ((const char *) &l->codetext.array[0], MaxCodeHunkLength, indent, curpos, left, seentext); - } -} - - -/* - Add - adds a character to a code hunk and creates another code hunk if necessary. -*/ - -static pge_CodeHunk Add (pge_CodeHunk *p, char ch, unsigned int *i) -{ - pge_CodeHunk q; - - if (((*p) == NULL) || ((*i) > MaxCodeHunkLength)) - { - Storage_ALLOCATE ((void **) &q, sizeof (pge__T9)); - q->next = (*p); - q->codetext.array[0] = ch; - (*i) = 1; - return q; - } - else - { - (*p)->codetext.array[(*i)] = ch; - (*i) += 1; - return (*p); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConsHunk - combine two possible code hunks. -*/ - -static void ConsHunk (pge_CodeHunk *p, pge_CodeHunk q) -{ - pge_CodeHunk r; - - if ((*p) != NULL) - { - r = q; - while (r->next != NULL) - { - r = r->next; - } - r->next = (*p); - } - (*p) = q; -} - - -/* - GetName - returns the next symbol which is checked for a legal name. -*/ - -static NameKey_Name GetName (void) -{ - NameKey_Name name; - - if (bnflex_IsReserved (bnflex_GetCurrentToken ())) - { - PushBackInput_WarnError ((const char *) "expecting a name and found a reserved word", 42); - bnflex_AdvanceToken (); /* move on to another token */ - return NameKey_NulName; /* move on to another token */ - } - else - { - name = bnflex_GetCurrentToken (); - bnflex_AdvanceToken (); - return name; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - SyntaxError - after a syntax error we skip all tokens up until we reach - a stop symbol. -*/ - -static void SyntaxError (pge_SetOfStop stop) -{ - DescribeError (); - if (Debugging) - { - StrIO_WriteLn (); - StrIO_WriteString ((const char *) "skipping token *** ", 19); - } - while (! ((((1 << (bnflex_GetCurrentTokenType ()-bnflex_identtok)) & (stop)) != 0))) - { - bnflex_AdvanceToken (); - } - if (Debugging) - { - StrIO_WriteString ((const char *) " ***", 4); - StrIO_WriteLn (); - } - WasNoError = FALSE; -} - - -/* - SyntaxCheck - -*/ - -static void SyntaxCheck (pge_SetOfStop stop) -{ - if (! ((((1 << (bnflex_GetCurrentTokenType ()-bnflex_identtok)) & (stop)) != 0))) - { - SyntaxError (stop); - } -} - - -/* - Expect - -*/ - -static void Expect (bnflex_TokenType t, pge_SetOfStop stop) -{ - if ((bnflex_GetCurrentTokenType ()) == t) - { - bnflex_AdvanceToken (); - } - else - { - SyntaxError (stop); - } - SyntaxCheck (stop); -} - - -/* - Ident - error checking varient of Ident -*/ - -static void Ident (pge_SetOfStop stop) -{ - if ((bnflex_GetCurrentTokenType ()) == bnflex_identtok) - { - Storage_ALLOCATE ((void **) &CurrentIdent, sizeof (pge__T1)); - CurrentIdent->definition = NULL; - CurrentIdent->name = GetName (); - CurrentIdent->line = PushBackInput_GetCurrentLine (); - } -} - - -/* - Modula2Code - error checking varient of Modula2Code -*/ - -static void Modula2Code (pge_SetOfStop stop) -{ - pge_CodeHunk p; - unsigned int i; - unsigned int quote; - unsigned int line; - unsigned int position; - - line = PushBackInput_GetCurrentLine (); - bnflex_PushBackToken (bnflex_GetCurrentToken ()); - position = PushBackInput_GetColumnPosition (); - p = NULL; - bnflex_SkipWhite (); - while (((bnflex_PutChar (bnflex_GetChar ())) != '%') && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) - { - if ((bnflex_PutChar (bnflex_GetChar ())) == '"') - { - /* avoid dangling else. */ - do { - p = Add (&p, bnflex_GetChar (), &i); - } while (! (((bnflex_PutChar (bnflex_GetChar ())) == '"') || ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_nul))); - p = Add (&p, '"', &i); - if (((bnflex_PutChar (bnflex_GetChar ())) == '"') && ((bnflex_GetChar ()) == '"')) - {} /* empty. */ - } - else if ((bnflex_PutChar (bnflex_GetChar ())) == '\'') - { - /* avoid dangling else. */ - do { - p = Add (&p, bnflex_GetChar (), &i); - } while (! (((bnflex_PutChar (bnflex_GetChar ())) == '\'') || ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_nul))); - p = Add (&p, '\'', &i); - if (((bnflex_PutChar (bnflex_GetChar ())) == '\'') && ((bnflex_GetChar ()) == '\'')) - {} /* empty. */ - } - else if (((bnflex_PutChar (bnflex_GetChar ())) == '\\') && ((bnflex_GetChar ()) == '\\')) - { - /* avoid dangling else. */ - p = Add (&p, bnflex_GetChar (), &i); - } - else if ((bnflex_PutChar (bnflex_GetChar ())) != '%') - { - /* avoid dangling else. */ - p = Add (&p, bnflex_GetChar (), &i); - } - } - p = Add (&p, ASCII_nul, &i); - CurrentFactor->type = pge_m2; - CurrentFactor->code = NewCodeDesc (); - CurrentFactor->code->code = p; - CurrentFactor->code->indent = position; - if ((bnflex_PutChar (' ')) == ' ') - {} /* empty. */ - bnflex_AdvanceToken (); /* read the next token ready for the parser */ - if (! WasNoError) /* read the next token ready for the parser */ - { - WarnError1 ((const char *) "error probably occurred before the start of inline code on line %d", 66, line); - } -} - - -/* - StartModName := % ModuleName := GetName() ; ignore begintok CodeFragmentPrologue % =: -*/ - -static void StartModName (pge_SetOfStop stop) -{ - ModuleName = GetName (); - CodeFragmentPrologue (); -} - - -/* - EndModName := -*/ - -static void EndModName (pge_SetOfStop stop) -{ - if (ModuleName != (GetName ())) - { - PushBackInput_WarnError ((const char *) "expecting same module name at end as beginning", 46); - } - /* ignore endtok as it consumes the token afterwards */ - CodeFragmentEpilogue (); -} - - -/* - DoDeclaration := % CodeFragmentDeclaration % =: -*/ - -static void DoDeclaration (pge_SetOfStop stop) -{ - if (ModuleName != (GetName ())) - { - PushBackInput_WarnError ((const char *) "expecting same module name in declaration as in the beginning", 61); - } - /* ignore begintok as it consumes the token afterwards */ - CodeFragmentDeclaration (); -} - - -/* - CollectLiteral := - % LastLiteral := GetCurrentToken() ; - AdvanceToken ; % - - - first symbols:literaltok - - cannot reachend -*/ - -static void CollectLiteral (pge_SetOfStop stopset) -{ - LastLiteral = bnflex_GetCurrentToken (); /* */ - bnflex_AdvanceToken (); -} - - -/* - CollectTok := - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := tokel ; - string := GetCurrentToken() ; - END ; - IF NOT ContainsSymKey(Values, GetCurrentToken()) - THEN - AddEntry(Values, GetCurrentToken(), LargestValue) ; - AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ; - AddEntry(Aliases, GetCurrentToken(), GetCurrentToken()) ; - AddEntry(ReverseAliases, GetCurrentToken(), GetCurrentToken()) ; - INC(LargestValue) - END ; - AdvanceToken() ; % - - - first symbols:identtok - - cannot reachend -*/ - -static void CollectTok (pge_SetOfStop stopset) -{ - CurrentSetDesc = NewSetDesc (); /* */ - CurrentSetDesc->type = pge_tokel; - CurrentSetDesc->string = bnflex_GetCurrentToken (); - if (! (SymbolKey_ContainsSymKey (Values, bnflex_GetCurrentToken ()))) - { - AddEntry (&Values, bnflex_GetCurrentToken (), LargestValue); - AddEntry (&ReverseValues, (NameKey_Name) (LargestValue), bnflex_GetCurrentToken ()); - AddEntry (&Aliases, bnflex_GetCurrentToken (), bnflex_GetCurrentToken ()); - AddEntry (&ReverseAliases, bnflex_GetCurrentToken (), bnflex_GetCurrentToken ()); - LargestValue += 1; - } - bnflex_AdvanceToken (); -} - - -/* - DefineToken := - % AddEntry(Aliases, LastLiteral, GetCurrentToken()) ; - AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ; - AddEntry(Values, GetCurrentToken(), LargestValue) ; - AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ; - INC(LargestValue) ; - AdvanceToken ; % - - - first symbols:identtok - - cannot reachend -*/ - -static void DefineToken (pge_SetOfStop stopset) -{ - AddEntry (&Aliases, LastLiteral, bnflex_GetCurrentToken ()); /* */ - AddEntry (&ReverseAliases, bnflex_GetCurrentToken (), LastLiteral); - AddEntry (&Values, bnflex_GetCurrentToken (), LargestValue); - AddEntry (&ReverseValues, (NameKey_Name) (LargestValue), bnflex_GetCurrentToken ()); - LargestValue += 1; - bnflex_AdvanceToken (); -} - - -/* - Rules := '%' 'rules' { Defs } ExtBNF - - first symbols:codetok - - cannot reachend -*/ - -static void Rules (pge_SetOfStop stopset) -{ - Expect (bnflex_codetok, stopset|(pge_SetOfStop) ((1 << (bnflex_rulestok-bnflex_identtok)))); - Expect (bnflex_rulestok, stopset|(pge_SetOfStop) ((1 << (bnflex_symfunctok-bnflex_identtok)) | (1 << (bnflex_tfunctok-bnflex_identtok)) | (1 << (bnflex_errortok-bnflex_identtok)) | (1 << (bnflex_tokentok-bnflex_identtok)) | (1 << (bnflex_specialtok-bnflex_identtok)) | (1 << (bnflex_BNFtok-bnflex_identtok)))); - while ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_specialtok)) | (1 << (bnflex_tokentok)) | (1 << (bnflex_errortok)) | (1 << (bnflex_tfunctok)) | (1 << (bnflex_symfunctok))))) != 0)) - { - Defs (stopset|(pge_SetOfStop) ((1 << (bnflex_BNFtok-bnflex_identtok)) | (1 << (bnflex_specialtok-bnflex_identtok)) | (1 << (bnflex_tokentok-bnflex_identtok)) | (1 << (bnflex_errortok-bnflex_identtok)) | (1 << (bnflex_tfunctok-bnflex_identtok)) | (1 << (bnflex_symfunctok-bnflex_identtok)))); - } - /* while */ - ExtBNF (stopset); -} - - -/* - Special := Ident - % VAR p: ProductionDesc ; % - - % p := NewProduction() ; - p^.statement := NewStatement() ; - p^.statement^.followinfo^.calcfollow := TRUE ; - p^.statement^.followinfo^.epsilon := false ; - p^.statement^.followinfo^.reachend := false ; - p^.statement^.ident := CurrentIdent ; - p^.statement^.expr := NIL ; - p^.firstsolved := TRUE ; - p^.followinfo^.calcfollow := TRUE ; - p^.followinfo^.epsilon := false ; - p^.followinfo^.reachend := false % - First Follow [ 'epsilon' - % p^.statement^.followinfo^.epsilon := true ; these are not used - but they are displayed when debugging - p^.statement^.followinfo^.reachend := true ; - p^.followinfo^.epsilon := true ; - p^.followinfo^.reachend := true - % - ] [ Literal - % p^.description := LastLiteral % - ] - - first symbols:identtok - - cannot reachend -*/ - -static void Special (pge_SetOfStop stopset) -{ - pge_ProductionDesc p; - - Ident (stopset|(pge_SetOfStop) ((1 << (bnflex_firsttok-bnflex_identtok)))); - p = NewProduction (); - p->statement = NewStatement (); - p->statement->followinfo->calcfollow = TRUE; - p->statement->followinfo->epsilon = pge_false; - p->statement->followinfo->reachend = pge_false; - p->statement->ident = CurrentIdent; - p->statement->expr = NULL; - p->firstsolved = TRUE; - p->followinfo->calcfollow = TRUE; - p->followinfo->epsilon = pge_false; - p->followinfo->reachend = pge_false; - First (stopset|(pge_SetOfStop) ((1 << (bnflex_followtok-bnflex_identtok)))); - Follow (stopset|(pge_SetOfStop) ((1 << (bnflex_epsilontok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)))); - if ((bnflex_GetCurrentTokenType ()) == bnflex_epsilontok) - { - Expect (bnflex_epsilontok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - p->statement->followinfo->epsilon = pge_true; /* these are not used - but they are displayed when debugging */ - p->statement->followinfo->reachend = pge_true; /* these are not used - but they are displayed when debugging */ - p->followinfo->epsilon = pge_true; - p->followinfo->reachend = pge_true; - } - if ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_dquotetok)) | (1 << (bnflex_squotetok))))) != 0)) - { - Literal (stopset); - p->description = LastLiteral; - } -} - - -/* - Factor := '%' Modula2Code '%' | - Ident - % WITH CurrentFactor^ DO - type := id ; - ident := CurrentIdent - END ; % - | Literal - % WITH CurrentFactor^ DO - type := lit ; - string := LastLiteral ; - IF GetSymKey(Aliases, LastLiteral)=NulName - THEN - WarnError1('no token defined for literal %s', LastLiteral) - END - END ; % - | '{' - % WITH CurrentFactor^ DO - type := mult ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression '}' | '[' - % WITH CurrentFactor^ DO - type := opt ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression ']' | '(' - % WITH CurrentFactor^ DO - type := sub ; - expr := NewExpression() ; - CurrentExpression := expr ; - END ; % - Expression ')' - - first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok - - cannot reachend -*/ - -static void Factor (pge_SetOfStop stopset) -{ - if ((bnflex_GetCurrentTokenType ()) == bnflex_codetok) - { - Expect (bnflex_codetok, stopset); - Modula2Code (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok)))); - Expect (bnflex_codetok, stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_identtok) - { - /* avoid dangling else. */ - Ident (stopset); - CurrentFactor->type = pge_id; - CurrentFactor->ident = CurrentIdent; - } - else if ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_dquotetok)) | (1 << (bnflex_squotetok))))) != 0)) - { - /* avoid dangling else. */ - Literal (stopset); - CurrentFactor->type = pge_lit; - CurrentFactor->string = LastLiteral; - if ((SymbolKey_GetSymKey (Aliases, LastLiteral)) == NameKey_NulName) - { - WarnError1 ((const char *) "no token defined for literal %s", 31, LastLiteral); - } - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_lcparatok) - { - /* avoid dangling else. */ - Expect (bnflex_lcparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - CurrentFactor->type = pge_mult; - CurrentFactor->expr = NewExpression (); - CurrentExpression = CurrentFactor->expr; - Expression (stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)))); - Expect (bnflex_rcparatok, stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_lsparatok) - { - /* avoid dangling else. */ - Expect (bnflex_lsparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - CurrentFactor->type = pge_opt; - CurrentFactor->expr = NewExpression (); - CurrentExpression = CurrentFactor->expr; - Expression (stopset|(pge_SetOfStop) ((1 << (bnflex_rsparatok-bnflex_identtok)))); - Expect (bnflex_rsparatok, stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_lparatok) - { - /* avoid dangling else. */ - Expect (bnflex_lparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - CurrentFactor->type = pge_sub; - CurrentFactor->expr = NewExpression (); - CurrentExpression = CurrentFactor->expr; - Expression (stopset|(pge_SetOfStop) ((1 << (bnflex_rparatok-bnflex_identtok)))); - Expect (bnflex_rparatok, stopset); - } - else - { - /* avoid dangling else. */ - PushBackInput_WarnError ((const char *) "expecting one of: ( [ { \" single quote identifier %", 51); - } -} - - -/* - Statement := - % VAR i: IdentDesc ; % - Ident - % VAR p: ProductionDesc ; % - - % p := FindDefinition(CurrentIdent^.name) ; - IF p=NIL - THEN - p := NewProduction() - ELSE - IF NOT ((p^.statement=NIL) OR (p^.statement^.expr=NIL)) - THEN - WarnError1('already declared rule %s', CurrentIdent^.name) - END - END ; - i := CurrentIdent ; % - ':=' - % VAR e: ExpressionDesc ; % - - % e := NewExpression() ; - CurrentExpression := e ; % - - % VAR s: StatementDesc ; % - - % s := NewStatement() ; - WITH s^ DO - ident := i ; - expr := e - END ; % - Expression - % p^.statement := s ; % - '=:' - - first symbols:identtok - - cannot reachend -*/ - -static void Statement (pge_SetOfStop stopset) -{ - pge_IdentDesc i; - pge_ProductionDesc p; - pge_ExpressionDesc e; - pge_StatementDesc s; - - Ident (stopset|(pge_SetOfStop) ((1 << (bnflex_lbecomestok-bnflex_identtok)))); - p = FindDefinition (CurrentIdent->name); - if (p == NULL) - { - p = NewProduction (); - } - else - { - if (! ((p->statement == NULL) || (p->statement->expr == NULL))) - { - WarnError1 ((const char *) "already declared rule %s", 24, CurrentIdent->name); - } - } - i = CurrentIdent; - Expect (bnflex_lbecomestok, stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - e = NewExpression (); - CurrentExpression = e; - s = NewStatement (); - s->ident = i; - s->expr = e; - Expression (stopset|(pge_SetOfStop) ((1 << (bnflex_rbecomestok-bnflex_identtok)))); - p->statement = s; - Expect (bnflex_rbecomestok, stopset); -} - - -/* - Defs := 'special' Special | 'token' Token | - 'error' ErrorProcedures | - 'tokenfunc' TokenProcedure | - 'symfunc' SymProcedure - - first symbols:symfunctok, tfunctok, errortok, tokentok, specialtok - - cannot reachend -*/ - -static void Defs (pge_SetOfStop stopset) -{ - if ((bnflex_GetCurrentTokenType ()) == bnflex_specialtok) - { - Expect (bnflex_specialtok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok)))); - Special (stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_tokentok) - { - /* avoid dangling else. */ - Expect (bnflex_tokentok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - Token (stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_errortok) - { - /* avoid dangling else. */ - Expect (bnflex_errortok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - ErrorProcedures (stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_tfunctok) - { - /* avoid dangling else. */ - Expect (bnflex_tfunctok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - TokenProcedure (stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_symfunctok) - { - /* avoid dangling else. */ - Expect (bnflex_symfunctok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - SymProcedure (stopset); - } - else - { - /* avoid dangling else. */ - PushBackInput_WarnError ((const char *) "expecting one of: symfunc tokenfunc error token special", 55); - } -} - - -/* - ExtBNF := 'BNF' { Production } 'FNB' - - first symbols:BNFtok - - cannot reachend -*/ - -static void ExtBNF (pge_SetOfStop stopset) -{ - Expect (bnflex_BNFtok, stopset|(pge_SetOfStop) ((1 << (bnflex_FNBtok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)))); - while ((bnflex_GetCurrentTokenType ()) == bnflex_identtok) - { - Production (stopset|(pge_SetOfStop) ((1 << (bnflex_FNBtok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)))); - } - /* while */ - Expect (bnflex_FNBtok, stopset); -} - - -/* - Main := Header Decls Footer Rules - - first symbols:codetok - - cannot reachend -*/ - -static void Main (pge_SetOfStop stopset) -{ - Header (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok)))); - Decls (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok)))); - Footer (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok)))); - Rules (stopset); -} - - -/* - Header := '%' 'module' StartModName - - first symbols:codetok - - cannot reachend -*/ - -static void Header (pge_SetOfStop stopset) -{ - Expect (bnflex_codetok, stopset|(pge_SetOfStop) ((1 << (bnflex_moduletok-bnflex_identtok)))); - Expect (bnflex_moduletok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok)))); - StartModName (stopset); -} - - -/* - Decls := '%' 'declaration' DoDeclaration - - first symbols:codetok - - cannot reachend -*/ - -static void Decls (pge_SetOfStop stopset) -{ - Expect (bnflex_codetok, stopset|(pge_SetOfStop) ((1 << (bnflex_declarationtok-bnflex_identtok)))); - Expect (bnflex_declarationtok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok)))); - DoDeclaration (stopset); -} - - -/* - Footer := '%' 'module' EndModName - - first symbols:codetok - - cannot reachend -*/ - -static void Footer (pge_SetOfStop stopset) -{ - Expect (bnflex_codetok, stopset|(pge_SetOfStop) ((1 << (bnflex_moduletok-bnflex_identtok)))); - Expect (bnflex_moduletok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok)))); - EndModName (stopset); -} - - -/* - First := 'first' '{' { LitOrTokenOrIdent - % WITH CurrentSetDesc^ DO - next := TailProduction^.first ; - END ; - TailProduction^.first := CurrentSetDesc - % - } '}' - - first symbols:firsttok - - cannot reachend -*/ - -static void First (pge_SetOfStop stopset) -{ - Expect (bnflex_firsttok, stopset|(pge_SetOfStop) ((1 << (bnflex_lcparatok-bnflex_identtok)))); - Expect (bnflex_lcparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_lesstok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - while ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_lesstok)) | (1 << (bnflex_identtok)) | (1 << (bnflex_squotetok)) | (1 << (bnflex_dquotetok))))) != 0)) - { - LitOrTokenOrIdent (stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)) | (1 << (bnflex_lesstok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)))); - CurrentSetDesc->next = TailProduction->first; - TailProduction->first = CurrentSetDesc; - } - /* while */ - Expect (bnflex_rcparatok, stopset); -} - - -/* - Follow := 'follow' '{' { LitOrTokenOrIdent - % WITH CurrentSetDesc^ DO - next := TailProduction^.followinfo^.follow ; - END ; - TailProduction^.followinfo^.follow := CurrentSetDesc - % - } '}' - - first symbols:followtok - - cannot reachend -*/ - -static void Follow (pge_SetOfStop stopset) -{ - Expect (bnflex_followtok, stopset|(pge_SetOfStop) ((1 << (bnflex_lcparatok-bnflex_identtok)))); - Expect (bnflex_lcparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_lesstok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - while ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_lesstok)) | (1 << (bnflex_identtok)) | (1 << (bnflex_squotetok)) | (1 << (bnflex_dquotetok))))) != 0)) - { - LitOrTokenOrIdent (stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)) | (1 << (bnflex_lesstok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)))); - CurrentSetDesc->next = TailProduction->followinfo->follow; - TailProduction->followinfo->follow = CurrentSetDesc; - } - /* while */ - Expect (bnflex_rcparatok, stopset); -} - - -/* - LitOrTokenOrIdent := Literal - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := litel ; - string := LastLiteral ; - END ; - % - | '<' CollectTok '>' | - Ident - % CurrentSetDesc := NewSetDesc() ; - WITH CurrentSetDesc^ DO - type := idel ; - ident := CurrentIdent ; - END ; - % - - - first symbols:dquotetok, squotetok, identtok, lesstok - - cannot reachend -*/ - -static void LitOrTokenOrIdent (pge_SetOfStop stopset) -{ - if ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_dquotetok)) | (1 << (bnflex_squotetok))))) != 0)) - { - Literal (stopset); - CurrentSetDesc = NewSetDesc (); - CurrentSetDesc->type = pge_litel; - CurrentSetDesc->string = LastLiteral; - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_lesstok) - { - /* avoid dangling else. */ - Expect (bnflex_lesstok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok)))); - CollectTok (stopset|(pge_SetOfStop) ((1 << (bnflex_gretok-bnflex_identtok)))); - Expect (bnflex_gretok, stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_identtok) - { - /* avoid dangling else. */ - Ident (stopset); - CurrentSetDesc = NewSetDesc (); - CurrentSetDesc->type = pge_idel; - CurrentSetDesc->ident = CurrentIdent; - } - else - { - /* avoid dangling else. */ - PushBackInput_WarnError ((const char *) "expecting one of: identifier < \" single quote", 45); - } -} - - -/* - Literal := '"' CollectLiteral '"' | - "'" CollectLiteral "'" - - first symbols:squotetok, dquotetok - - cannot reachend -*/ - -static void Literal (pge_SetOfStop stopset) -{ - if ((bnflex_GetCurrentTokenType ()) == bnflex_dquotetok) - { - Expect (bnflex_dquotetok, stopset|(pge_SetOfStop) ((1 << (bnflex_literaltok-bnflex_identtok)))); - CollectLiteral (stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)))); - Expect (bnflex_dquotetok, stopset); - } - else if ((bnflex_GetCurrentTokenType ()) == bnflex_squotetok) - { - /* avoid dangling else. */ - Expect (bnflex_squotetok, stopset|(pge_SetOfStop) ((1 << (bnflex_literaltok-bnflex_identtok)))); - CollectLiteral (stopset|(pge_SetOfStop) ((1 << (bnflex_squotetok-bnflex_identtok)))); - Expect (bnflex_squotetok, stopset); - } - else - { - /* avoid dangling else. */ - PushBackInput_WarnError ((const char *) "expecting one of: single quote \"", 32); - } -} - - -/* - Token := Literal DefineToken - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void Token (pge_SetOfStop stopset) -{ - Literal (stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok)))); - DefineToken (stopset); -} - - -/* - ErrorProcedures := Literal - % ErrorProcArray := LastLiteral % - Literal - % ErrorProcString := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void ErrorProcedures (pge_SetOfStop stopset) -{ - Literal (stopset|(pge_SetOfStop) ((1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)))); - ErrorProcArray = LastLiteral; - Literal (stopset); - ErrorProcString = LastLiteral; -} - - -/* - TokenProcedure := Literal - % TokenTypeProc := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void TokenProcedure (pge_SetOfStop stopset) -{ - Literal (stopset); - TokenTypeProc = LastLiteral; -} - - -/* - SymProcedure := Literal - % SymIsProc := LastLiteral % - - - first symbols:dquotetok, squotetok - - cannot reachend -*/ - -static void SymProcedure (pge_SetOfStop stopset) -{ - Literal (stopset); - SymIsProc = LastLiteral; -} - - -/* - Production := Statement - - first symbols:identtok - - cannot reachend -*/ - -static void Production (pge_SetOfStop stopset) -{ - Statement (stopset); -} - - -/* - Expression := - % VAR t1, t2: TermDesc ; - e : ExpressionDesc ; % - - % e := CurrentExpression ; - t1 := NewTerm() ; - CurrentTerm := t1 ; % - Term - % e^.term := t1 ; % - { '|' - % t2 := NewTerm() ; - CurrentTerm := t2 % - Term - % t1^.next := t2 ; - t1 := t2 % - } - - first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok - - cannot reachend -*/ - -static void Expression (pge_SetOfStop stopset) -{ - pge_TermDesc t1; - pge_TermDesc t2; - pge_ExpressionDesc e; - - e = CurrentExpression; - t1 = NewTerm (); - CurrentTerm = t1; - Term (stopset|(pge_SetOfStop) ((1 << (bnflex_bartok-bnflex_identtok)))); - e->term = t1; - while ((bnflex_GetCurrentTokenType ()) == bnflex_bartok) - { - Expect (bnflex_bartok, stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)))); - t2 = NewTerm (); - CurrentTerm = t2; - Term (stopset|(pge_SetOfStop) ((1 << (bnflex_bartok-bnflex_identtok)))); - t1->next = t2; - t1 = t2; - } - /* while */ -} - - -/* - Term := - % VAR t1: TermDesc ; f1, f2: FactorDesc ; % - - % CurrentFactor := NewFactor() ; - f1 := CurrentFactor ; - t1 := CurrentTerm ; % - Factor - % t1^.factor := f1 ; - f2 := NewFactor() ; - CurrentFactor := f2 % - { Factor - % f1^.next := f2 ; - f1 := f2 ; - f2 := NewFactor() ; - CurrentFactor := f2 ; % - } - - first symbols:squotetok, dquotetok, codetok, identtok, lcparatok, lsparatok, lparatok - - cannot reachend -*/ - -static void Term (pge_SetOfStop stopset) -{ - pge_TermDesc t1; - pge_FactorDesc f1; - pge_FactorDesc f2; - - CurrentFactor = NewFactor (); - f1 = CurrentFactor; - t1 = CurrentTerm; - Factor (stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)))); - t1->factor = f1; - f2 = NewFactor (); - CurrentFactor = f2; - while ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_codetok)) | (1 << (bnflex_identtok)) | (1 << (bnflex_lcparatok)) | (1 << (bnflex_lsparatok)) | (1 << (bnflex_lparatok)) | (1 << (bnflex_squotetok)) | (1 << (bnflex_dquotetok))))) != 0)) - { - Factor (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)))); - f1->next = f2; - f1 = f2; - f2 = NewFactor (); - CurrentFactor = f2; - } - /* while */ -} - - -/* - GetDefinitionName - returns the name of the rule inside, p. -*/ - -static NameKey_Name GetDefinitionName (pge_ProductionDesc p) -{ - if (p != NULL) - { - if ((p->statement != NULL) && (p->statement->ident != NULL)) - { - return p->statement->ident->name; - } - } - return NameKey_NulName; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FindDefinition - searches and returns the rule which defines, n. -*/ - -static pge_ProductionDesc FindDefinition (NameKey_Name n) -{ - pge_ProductionDesc p; - pge_ProductionDesc f; - - p = HeadProduction; - f = NULL; - while (p != NULL) - { - if ((GetDefinitionName (p)) == n) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (f == NULL) - { - f = p; - } - else - { - StrIO_WriteString ((const char *) "multiple definition for rule: ", 30); - NameKey_WriteKey (n); - StrIO_WriteLn (); - } - } - p = p->next; - } - return f; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - BackPatchIdent - found an ident, i, we must look for the corresponding rule and - set the definition accordingly. -*/ - -static void BackPatchIdent (pge_IdentDesc i) -{ - if (i != NULL) - { - i->definition = FindDefinition (i->name); - if (i->definition == NULL) - { - WarnError1 ((const char *) "unable to find production %s", 28, i->name); - WasNoError = FALSE; - } - } -} - - -/* - BackPatchFactor - runs through the factor looking for an ident -*/ - -static void BackPatchFactor (pge_FactorDesc f) -{ - while (f != NULL) - { - switch (f->type) - { - case pge_id: - BackPatchIdent (f->ident); - break; - - case pge_sub: - case pge_opt: - case pge_mult: - BackPatchExpression (f->expr); - break; - - - default: - break; - } - f = f->next; - } -} - - -/* - BackPatchTerm - runs through all terms to find idents. -*/ - -static void BackPatchTerm (pge_TermDesc t) -{ - while (t != NULL) - { - BackPatchFactor (t->factor); - t = t->next; - } -} - - -/* - BackPatchExpression - runs through the term to find any idents. -*/ - -static void BackPatchExpression (pge_ExpressionDesc e) -{ - if (e != NULL) - { - BackPatchTerm (e->term); - } -} - - -/* - BackPatchSet - -*/ - -static void BackPatchSet (pge_SetDesc s) -{ - while (s != NULL) - { - switch (s->type) - { - case pge_idel: - BackPatchIdent (s->ident); - break; - - - default: - break; - } - s = s->next; - } -} - - -/* - BackPatchIdentToDefinitions - search through all the rules and add a link from any ident - to the definition. -*/ - -static void BackPatchIdentToDefinitions (pge_ProductionDesc d) -{ - if ((d != NULL) && (d->statement != NULL)) - { - BackPatchExpression (d->statement->expr); - } -} - - -/* - CalculateFirstAndFollow - -*/ - -static void CalculateFirstAndFollow (pge_ProductionDesc p) -{ - if (Debugging) - { - StrIO_WriteLn (); - NameKey_WriteKey (p->statement->ident->name); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " calculating first", 19); - } - CalcFirstProduction (p, p, &p->first); - BackPatchSet (p->first); - if (Debugging) - { - StrIO_WriteString ((const char *) " calculating follow set", 24); - } - if (p->followinfo->follow == NULL) - { - CalcFollowProduction (p); - } - BackPatchSet (p->followinfo->follow); -} - - -/* - ForeachRuleDo - -*/ - -static void ForeachRuleDo (pge_DoProcedure p) -{ - CurrentProduction = HeadProduction; - while (CurrentProduction != NULL) - { - (*p.proc) (CurrentProduction); - CurrentProduction = CurrentProduction->next; - } -} - - -/* - WhileNotCompleteDo - -*/ - -static void WhileNotCompleteDo (pge_DoProcedure p) -{ - do { - Finished = TRUE; - ForeachRuleDo (p); - } while (! (Finished)); -} - - -/* - NewLine - generate a newline and indent. -*/ - -static void NewLine (unsigned int Left) -{ - Output_WriteLn (); - BeginningOfLine = TRUE; - Indent = 0; - while (Indent < Left) - { - Output_Write (' '); - Indent += 1; - } -} - - -/* - CheckNewLine - -*/ - -static void CheckNewLine (unsigned int Left) -{ - if (Indent == Left) - { - Left = BaseNewLine; - } - if (Indent > BaseRightMargin) - { - NewLine (Left); - } -} - - -/* - IndentString - writes out a string with a preceeding indent. -*/ - -static void IndentString (const char *a_, unsigned int _a_high) -{ - unsigned int i; - char a[_a_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (a, a_, _a_high+1); - - i = 0; - while (i < Indent) - { - Output_Write (' '); - i += 1; - } - Output_WriteString ((const char *) a, _a_high); - LastLineNo = 0; -} - - -/* - KeyWord - writes out a keywork with optional formatting directives. -*/ - -static void KeyWord (NameKey_Name n) -{ - if (KeywordFormatting) - { - Output_WriteString ((const char *) "{%K", 3); - if (((n == (NameKey_MakeKey ((const char *) "}", 1))) || (n == (NameKey_MakeKey ((const char *) "{", 1)))) || (n == (NameKey_MakeKey ((const char *) "%", 1)))) - { - Output_Write ('%'); /* escape }, { or % */ - } - Output_WriteKey (n); - Output_Write ('}'); - } - else - { - Output_WriteKey (n); - } -} - - -/* - PrettyPara - -*/ - -static void PrettyPara (const char *c1_, unsigned int _c1_high, const char *c2_, unsigned int _c2_high, pge_ExpressionDesc e, unsigned int Left) -{ - char c1[_c1_high+1]; - char c2[_c2_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (c1, c1_, _c1_high+1); - memcpy (c2, c2_, _c2_high+1); - - Output_WriteString ((const char *) c1, _c1_high); - Indent += StrLib_StrLen ((const char *) c1, _c1_high); - Left = Indent; - PrettyCommentExpression (e, Left); - Output_WriteString ((const char *) c2, _c2_high); - Indent += StrLib_StrLen ((const char *) c2, _c2_high); -} - - -/* - WriteKeyTexinfo - -*/ - -static void WriteKeyTexinfo (NameKey_Name s) -{ - DynamicStrings_String ds; - char ch; - unsigned int i; - unsigned int l; - - if (Texinfo) - { - ds = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (s)); - l = DynamicStrings_Length (ds); - i = 0; - while (i < l) - { - ch = DynamicStrings_char (ds, static_cast (i)); - if ((ch == '{') || (ch == '}')) - { - Output_Write ('@'); - } - Output_Write (ch); - i += 1; - } - } - else - { - Output_WriteKey (s); - } -} - - -/* - PrettyCommentFactor - -*/ - -static void PrettyCommentFactor (pge_FactorDesc f, unsigned int Left) -{ - unsigned int curpos; - unsigned int seentext; - - while (f != NULL) - { - CheckNewLine (Left); - switch (f->type) - { - case pge_id: - Output_WriteKey (f->ident->name); - Output_WriteString ((const char *) " ", 1); - Indent += (NameKey_LengthKey (f->ident->name))+1; - break; - - case pge_lit: - if ((NameKey_MakeKey ((const char *) "'", 1)) == f->string) - { - Output_Write ('"'); - WriteKeyTexinfo (f->string); - Output_WriteString ((const char *) "\" ", 2); - } - else - { - Output_Write ('\''); - WriteKeyTexinfo (f->string); - Output_WriteString ((const char *) "' ", 2); - } - Indent += (NameKey_LengthKey (f->string))+3; - break; - - case pge_sub: - PrettyPara ((const char *) "( ", 2, (const char *) " ) ", 3, f->expr, Left); - break; - - case pge_opt: - PrettyPara ((const char *) "[ ", 2, (const char *) " ] ", 3, f->expr, Left); - break; - - case pge_mult: - if (Texinfo) - { - PrettyPara ((const char *) "@{ ", 3, (const char *) " @} ", 4, f->expr, Left); - } - else - { - PrettyPara ((const char *) "{ ", 2, (const char *) " } ", 3, f->expr, Left); - } - break; - - case pge_m2: - if (EmitCode) - { - NewLine (Left); - Output_WriteString ((const char *) "% ", 2); - seentext = FALSE; - curpos = 0; - WriteCodeHunkListIndent (f->code->code, f->code->indent, &curpos, Left+2, &seentext); - Output_WriteString ((const char *) " %", 2); - NewLine (Left); - } - break; - - - default: - break; - } - PrettyFollow ((const char *) "", 3, f->followinfo); - f = f->next; - } -} - - -/* - PeepTerm - returns the length of characters in term. -*/ - -static unsigned int PeepTerm (pge_TermDesc t) -{ - unsigned int l; - - l = 0; - while (t != NULL) - { - l += PeepFactor (t->factor); - if (t->next != NULL) - { - l += 3; - } - t = t->next; - } - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PeepExpression - returns the length of the expression. -*/ - -static unsigned int PeepExpression (pge_ExpressionDesc e) -{ - if (e == NULL) - { - return 0; - } - else - { - return PeepTerm (e->term); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PeepFactor - returns the length of character in the factor -*/ - -static unsigned int PeepFactor (pge_FactorDesc f) -{ - unsigned int l; - - l = 0; - while (f != NULL) - { - switch (f->type) - { - case pge_id: - l += (NameKey_LengthKey (f->ident->name))+1; - break; - - case pge_lit: - l += (NameKey_LengthKey (f->string))+3; - break; - - case pge_opt: - case pge_mult: - case pge_sub: - l += PeepExpression (f->expr); - break; - - case pge_m2: - break; - - - default: - break; - } - f = f->next; /* empty */ - } - return l; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - PrettyCommentTerm - -*/ - -static void PrettyCommentTerm (pge_TermDesc t, unsigned int Left) -{ - while (t != NULL) - { - CheckNewLine (Left); - PrettyCommentFactor (t->factor, Left); - if (t->next != NULL) - { - Output_WriteString ((const char *) " | ", 3); - Indent += 3; - if (((PeepFactor (t->factor))+Indent) > BaseRightMargin) - { - NewLine (Left); - } - } - PrettyFollow ((const char *) "", 3, t->followinfo); - t = t->next; - } -} - - -/* - PrettyCommentExpression - -*/ - -static void PrettyCommentExpression (pge_ExpressionDesc e, unsigned int Left) -{ - if (e != NULL) - { - PrettyCommentTerm (e->term, Left); - PrettyFollow ((const char *) "", 3, e->followinfo); - } -} - - -/* - PrettyCommentStatement - -*/ - -static void PrettyCommentStatement (pge_StatementDesc s, unsigned int Left) -{ - if (s != NULL) - { - PrettyCommentExpression (s->expr, Left); - PrettyFollow ((const char *) "", 3, s->followinfo); - } -} - - -/* - PrettyCommentProduction - generates the comment for rule, p. -*/ - -static void PrettyCommentProduction (pge_ProductionDesc p) -{ - pge_SetDesc to; - - if (p != NULL) - { - BeginningOfLine = TRUE; - Indent = 0; - Output_WriteString ((const char *) "(*", 2); - NewLine (3); - Output_WriteKey (GetDefinitionName (p)); - Output_WriteString ((const char *) " := ", 4); - Indent += (NameKey_LengthKey (GetDefinitionName (p)))+4; - PrettyCommentStatement (p->statement, Indent); - NewLine (0); - if (ErrorRecovery) - { - NewLine (3); - Output_WriteString ((const char *) "first symbols:", 15); - EmitSet (p->first, static_cast (0), static_cast (0)); - NewLine (3); - PrettyFollow ((const char *) "", 3, p->followinfo); - NewLine (3); - switch (GetReachEnd (p->followinfo)) - { - case pge_true: - Output_WriteString ((const char *) "reachend", 8); - break; - - case pge_false: - Output_WriteString ((const char *) "cannot reachend", 15); - break; - - case pge_unknown: - Output_WriteString ((const char *) "unknown...", 10); - break; - - - default: - break; - } - NewLine (0); - } - Output_WriteString ((const char *) "*)", 2); - NewLine (0); - } -} - - -/* - PrettyPrintProduction - pretty prints the ebnf rule, p. -*/ - -static void PrettyPrintProduction (pge_ProductionDesc p) -{ - pge_SetDesc to; - - if (p != NULL) - { - BeginningOfLine = TRUE; - Indent = 0; - if (Texinfo) - { - Output_WriteString ((const char *) "@example", 8); - NewLine (0); - } - else if (Sphinx) - { - /* avoid dangling else. */ - Output_WriteString ((const char *) ".. code-block:: ebnf", 20); - NewLine (0); - } - Output_WriteKey (GetDefinitionName (p)); - Output_WriteString ((const char *) " := ", 4); - Indent += (NameKey_LengthKey (GetDefinitionName (p)))+4; - PrettyCommentStatement (p->statement, Indent); - if (p->description != NameKey_NulName) - { - Output_WriteKey (p->description); - } - NewLine (0); - WriteIndent ((NameKey_LengthKey (GetDefinitionName (p)))+1); - Output_WriteString ((const char *) " =: ", 4); - NewLine (0); - if (Texinfo) - { - Output_WriteString ((const char *) "@findex ", 8); - Output_WriteKey (GetDefinitionName (p)); - Output_WriteString ((const char *) " (ebnf)", 7); - NewLine (0); - Output_WriteString ((const char *) "@end example", 12); - NewLine (0); - } - else if (Sphinx) - { - /* avoid dangling else. */ - Output_WriteString ((const char *) ".. index::", 10); - NewLine (0); - Output_WriteString ((const char *) " pair: ", 8); - Output_WriteKey (GetDefinitionName (p)); - Output_WriteString ((const char *) "; (ebnf)", 8); - NewLine (0); - } - NewLine (0); - } -} - - -/* - EmitFileLineTag - emits a line and file tag using the C preprocessor syntax. -*/ - -static void EmitFileLineTag (unsigned int line) -{ - if (! SuppressFileLineTag && (line != LastLineNo)) - { - LastLineNo = line; - if (! OnLineStart) - { - Output_WriteLn (); - } - Output_WriteString ((const char *) "# ", 2); - Output_WriteCard (line, 0); - Output_WriteString ((const char *) " \"", 2); - Output_WriteString ((const char *) &FileName.array[0], MaxFileName); - Output_Write ('"'); - Output_WriteLn (); - OnLineStart = TRUE; - } -} - - -/* - EmitRule - generates a comment and code for rule, p. -*/ - -static void EmitRule (pge_ProductionDesc p) -{ - if (PrettyPrint) - { - PrettyPrintProduction (p); - } - else - { - PrettyCommentProduction (p); - if (ErrorRecovery) - { - RecoverProduction (p); - } - else - { - CodeProduction (p); - } - } -} - - -/* - CodeCondition - -*/ - -static void CodeCondition (pge_m2condition m) -{ - switch (m) - { - case pge_m2if: - case pge_m2none: - IndentString ((const char *) "IF ", 3); - break; - - case pge_m2elsif: - IndentString ((const char *) "ELSIF ", 6); - break; - - case pge_m2while: - IndentString ((const char *) "WHILE ", 6); - break; - - - default: - Debug_Halt ((const char *) "unrecognised m2condition", 24, 2680, (const char *) "m2/gm2-auto/pge.mod", 19); - break; - } -} - - -/* - CodeThenDo - codes a "THEN" or "DO" depending upon, m. -*/ - -static void CodeThenDo (pge_m2condition m) -{ - switch (m) - { - case pge_m2if: - case pge_m2none: - case pge_m2elsif: - if (LastLineNo == 0) - { - Output_WriteLn (); - } - IndentString ((const char *) "THEN", 4); - Output_WriteLn (); - break; - - case pge_m2while: - Output_WriteString ((const char *) " DO", 3); - Output_WriteLn (); - break; - - - default: - Debug_Halt ((const char *) "unrecognised m2condition", 24, 2705, (const char *) "m2/gm2-auto/pge.mod", 19); - break; - } - OnLineStart = TRUE; -} - - -/* - CodeElseEnd - builds an ELSE END statement using string, end. -*/ - -static void CodeElseEnd (const char *end_, unsigned int _end_high, unsigned int consumed, pge_FactorDesc f, unsigned int inopt) -{ - char end[_end_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (end, end_, _end_high+1); - - Output_WriteLn (); - OnLineStart = TRUE; - EmitFileLineTag (f->line); - if (! inopt) - { - IndentString ((const char *) "ELSE", 4); - StrIO_WriteLn (); - Indent += 3; - if (consumed) - { - IndentString ((const char *) "", 0); - Output_WriteKey (ErrorProcArray); - Output_Write ('('); - switch (f->type) - { - case pge_id: - Output_Write ('\''); - Output_WriteKey (f->ident->name); - Output_WriteString ((const char *) " - expected", 11); - Output_WriteString ((const char *) "') ;", 4); - break; - - case pge_lit: - if ((NameKey_MakeKey ((const char *) "'", 1)) == f->string) - { - Output_Write ('"'); - KeyWord (f->string); - Output_WriteString ((const char *) " - expected", 11); - Output_WriteString ((const char *) "\") ;", 4); - } - else if ((NameKey_MakeKey ((const char *) "\"", 1)) == f->string) - { - /* avoid dangling else. */ - Output_Write ('\''); - KeyWord (f->string); - Output_WriteString ((const char *) " - expected", 11); - Output_WriteString ((const char *) "') ;", 4); - } - else - { - /* avoid dangling else. */ - Output_Write ('"'); - Output_Write ('\''); - KeyWord (f->string); - Output_WriteString ((const char *) "' - expected", 12); - Output_WriteString ((const char *) "\") ;", 4); - } - break; - - - default: - break; - } - Output_WriteLn (); - } - IndentString ((const char *) "RETURN( FALSE )", 15); - Indent -= 3; - Output_WriteLn (); - } - IndentString ((const char *) end, _end_high); - Output_WriteLn (); - OnLineStart = TRUE; -} - - -/* - CodeEnd - codes a "END" depending upon, m. -*/ - -static void CodeEnd (pge_m2condition m, pge_TermDesc t, unsigned int consumed, pge_FactorDesc f, unsigned int inopt) -{ - Indent -= 3; - Output_WriteLn (); - OnLineStart = TRUE; - switch (m) - { - case pge_m2none: - if (t == NULL) - { - CodeElseEnd ((const char *) "END ;", 5, consumed, f, inopt); - } - break; - - case pge_m2if: - if (t == NULL) - { - CodeElseEnd ((const char *) "END ; (* if *)", 15, consumed, f, inopt); - } - break; - - case pge_m2elsif: - if (t == NULL) - { - CodeElseEnd ((const char *) "END ; (* elsif *)", 18, consumed, f, inopt); - } - break; - - case pge_m2while: - IndentString ((const char *) "END ; (* while *)", 18); - break; - - - default: - Debug_Halt ((const char *) "unrecognised m2condition", 24, 2788, (const char *) "m2/gm2-auto/pge.mod", 19); - break; - } - OnLineStart = FALSE; -} - - -/* - EmitNonVarCode - writes out, code, providing it is not a variable declaration. -*/ - -static void EmitNonVarCode (pge_CodeDesc code, unsigned int curpos, unsigned int left) -{ - unsigned int i; - pge_CodeHunk t; - unsigned int seentext; - - t = code->code; - if ((! (FindStr (&t, &i, (const char *) "VAR", 3))) && EmitCode) - { - seentext = FALSE; - curpos = 0; - EmitFileLineTag (code->line); - IndentString ((const char *) "", 0); - WriteCodeHunkListIndent (code->code, code->indent, &curpos, left, &seentext); - Output_WriteString ((const char *) " ;", 2); - Output_WriteLn (); - OnLineStart = TRUE; - } -} - - -/* - ChainOn - -*/ - -static pge_FactorDesc ChainOn (pge_FactorDesc codeStack, pge_FactorDesc f) -{ - pge_FactorDesc s; - - f->pushed = NULL; - if (codeStack == NULL) - { - return f; - } - else - { - s = codeStack; - while (s->pushed != NULL) - { - s = s->pushed; - } - s->pushed = f; - return codeStack; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FlushCode - -*/ - -static void FlushCode (pge_FactorDesc *codeStack) -{ - if ((*codeStack) != NULL) - { - NewLine (Indent); - Output_WriteString ((const char *) "(* begin flushing code *)", 25); - OnLineStart = FALSE; - while ((*codeStack) != NULL) - { - NewLine (Indent); - EmitNonVarCode ((*codeStack)->code, 0, Indent); - NewLine (Indent); - (*codeStack) = (*codeStack)->pushed; - if ((*codeStack) != NULL) - { - Output_WriteString ((const char *) " (* again flushing code *)", 26); - Output_WriteLn (); - OnLineStart = TRUE; - } - } - NewLine (Indent); - Output_WriteString ((const char *) "(* end flushing code *)", 23); - OnLineStart = FALSE; - } -} - - -/* - CodeFactor - -*/ - -static void CodeFactor (pge_FactorDesc f, pge_TermDesc t, pge_m2condition l, pge_m2condition n, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack) -{ - if (f == NULL) - { - /* avoid dangling else. */ - if (! inwhile && ! inopt) /* ((l=m2elsif) OR (l=m2if) OR (l=m2none)) AND */ - { - Output_WriteLn (); - IndentString ((const char *) "RETURN( TRUE )", 14); - OnLineStart = FALSE; - } - } - else - { - EmitFileLineTag (f->line); - switch (f->type) - { - case pge_id: - FlushCode (&codeStack); - CodeCondition (n); - Output_WriteKey (f->ident->name); - Output_WriteString ((const char *) "()", 2); - CodeThenDo (n); - Indent += 3; - CodeFactor (f->next, NULL, n, pge_m2none, inopt, inwhile, TRUE, NULL); - CodeEnd (n, t, consumed, f, inopt); - break; - - case pge_lit: - FlushCode (&codeStack); - CodeCondition (n); - Output_WriteKey (SymIsProc); - Output_Write ('('); - Output_WriteKey (SymbolKey_GetSymKey (Aliases, f->string)); - Output_Write (')'); - CodeThenDo (n); - Indent += 3; - CodeFactor (f->next, NULL, n, pge_m2none, inopt, inwhile, TRUE, NULL); - CodeEnd (n, t, consumed, f, inopt); - break; - - case pge_sub: - FlushCode (&codeStack); - CodeExpression (f->expr, pge_m2none, inopt, inwhile, consumed, NULL); - if (f->next != NULL) - { - /* - * the test above makes sure that we don't emit a RETURN( TRUE ) - * after a subexpression. Remember sub expressions are not conditional - */ - CodeFactor (f->next, t, n, pge_m2none, inopt, inwhile, TRUE, NULL); - } - break; - - case pge_opt: - FlushCode (&codeStack); - CodeExpression (f->expr, pge_m2if, TRUE, inwhile, FALSE, NULL); - CodeFactor (f->next, t, n, pge_m2none, inopt, inwhile, consumed, NULL); - break; - - case pge_mult: - FlushCode (&codeStack); - CodeExpression (f->expr, pge_m2while, FALSE, TRUE, consumed, NULL); - CodeFactor (f->next, t, n, pge_m2none, inopt, inwhile, consumed, NULL); - break; - - case pge_m2: - codeStack = ChainOn (codeStack, f); - if (consumed || (f->next == NULL)) - { - FlushCode (&codeStack); - } - CodeFactor (f->next, t, n, pge_m2none, inopt, inwhile, consumed, codeStack); - break; - - - default: - break; - } - } -} - - -/* - CodeTerm - -*/ - -static void CodeTerm (pge_TermDesc t, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack) -{ - pge_m2condition l; - - l = m; - while (t != NULL) - { - EmitFileLineTag (t->line); - if ((t->factor->type == pge_m2) && (m == pge_m2elsif)) - { - m = pge_m2if; - IndentString ((const char *) "ELSE", 4); - Output_WriteLn (); - OnLineStart = TRUE; - Indent += 3; - CodeFactor (t->factor, t->next, pge_m2none, pge_m2none, inopt, inwhile, consumed, codeStack); - Indent -= 3; - IndentString ((const char *) "END ;", 5); - Output_WriteLn (); - OnLineStart = TRUE; - } - else - { - CodeFactor (t->factor, t->next, pge_m2none, m, inopt, inwhile, consumed, codeStack); - } - l = m; - if (t->next != NULL) - { - m = pge_m2elsif; - } - t = t->next; - } -} - - -/* - CodeExpression - -*/ - -static void CodeExpression (pge_ExpressionDesc e, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack) -{ - if (e != NULL) - { - EmitFileLineTag (e->line); - CodeTerm (e->term, m, inopt, inwhile, consumed, codeStack); - } -} - - -/* - CodeStatement - -*/ - -static void CodeStatement (pge_StatementDesc s, pge_m2condition m) -{ - if (s != NULL) - { - EmitFileLineTag (s->line); - CodeExpression (s->expr, m, FALSE, FALSE, FALSE, NULL); - } -} - - -/* - CodeProduction - only encode grammer rules which are not special. -*/ - -static void CodeProduction (pge_ProductionDesc p) -{ - if ((p != NULL) && (! p->firstsolved || ((p->statement != NULL) && (p->statement->expr != NULL)))) - { - BeginningOfLine = TRUE; - Indent = 0; - Output_WriteLn (); - EmitFileLineTag (p->line); - IndentString ((const char *) "PROCEDURE ", 10); - Output_WriteKey (GetDefinitionName (p)); - Output_WriteString ((const char *) " () : BOOLEAN ;", 15); - VarProduction (p); - Output_WriteLn (); - OnLineStart = TRUE; - EmitFileLineTag (p->line); - IndentString ((const char *) "BEGIN", 5); - StrIO_WriteLn (); - OnLineStart = FALSE; - EmitFileLineTag (p->line); - Indent = 3; - CodeStatement (p->statement, pge_m2none); - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "END ", 4); - NameKey_WriteKey (GetDefinitionName (p)); - Output_WriteString ((const char *) " ;", 2); - Output_WriteLn (); - Output_WriteLn (); - Output_WriteLn (); - } -} - - -/* - RecoverCondition - -*/ - -static void RecoverCondition (pge_m2condition m) -{ - switch (m) - { - case pge_m2if: - IndentString ((const char *) "IF ", 3); - break; - - case pge_m2none: - IndentString ((const char *) "IF ", 3); - break; - - case pge_m2elsif: - IndentString ((const char *) "ELSIF ", 6); - break; - - case pge_m2while: - IndentString ((const char *) "WHILE ", 6); - break; - - - default: - Debug_Halt ((const char *) "unrecognised m2condition", 24, 3045, (const char *) "m2/gm2-auto/pge.mod", 19); - break; - } -} - - -/* - ConditionIndent - returns the number of spaces indentation created via, m. -*/ - -static unsigned int ConditionIndent (pge_m2condition m) -{ - switch (m) - { - case pge_m2if: - return 3; - break; - - case pge_m2none: - return 3; - break; - - case pge_m2elsif: - return 6; - break; - - case pge_m2while: - return 6; - break; - - - default: - Debug_Halt ((const char *) "unrecognised m2condition", 24, 3064, (const char *) "m2/gm2-auto/pge.mod", 19); - break; - } - ReturnException ("m2/gm2-auto/pge.mod", 1, 7); - __builtin_unreachable (); -} - - -/* - WriteGetTokenType - writes out the method of determining the token type. -*/ - -static void WriteGetTokenType (void) -{ - Output_WriteKey (TokenTypeProc); -} - - -/* - NumberOfElements - returns the number of elements in set, to, which lie between low..high -*/ - -static unsigned int NumberOfElements (pge_SetDesc to, unsigned int low, unsigned int high) -{ - unsigned int n; - - n = 0; - while (to != NULL) - { - switch (to->type) - { - case pge_tokel: - if ((high == 0) || (IsBetween (to->string, low, high))) - { - n += 1; - } - break; - - case pge_litel: - if ((high == 0) || (IsBetween (SymbolKey_GetSymKey (Aliases, to->string), low, high))) - { - n += 1; - } - break; - - case pge_idel: - PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40); - WasNoError = FALSE; - break; - - - default: - PushBackInput_WarnError ((const char *) "unknown enuneration element", 27); - WasNoError = FALSE; - break; - } - to = to->next; - } - return n; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WriteElement - writes the literal name for element, e. -*/ - -static void WriteElement (unsigned int e) -{ - Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, e)); -} - - -/* - EmitIsInSet - writes out the equivalent of GetTokenType() IN { toset } -*/ - -static void EmitIsInSet (pge_SetDesc to, NameKey_Name low, NameKey_Name high) -{ - if ((NumberOfElements (to, low, high)) == 1) - { - WriteGetTokenType (); - Output_Write ('='); - EmitSet (to, low, high); - } - else - { - WriteGetTokenType (); - Output_WriteString ((const char *) " IN SetOfStop", 13); - if (LargestValue > MaxElementsInSet) - { - Output_WriteCard (((unsigned int ) (low)) / MaxElementsInSet, 0); - } - Output_WriteString ((const char *) " {", 2); - EmitSet (to, low, high); - Output_WriteString ((const char *) "}", 1); - } -} - - -/* - EmitIsInSubSet - writes out a test to see whether GetTokenype() is in { subset } -*/ - -static void EmitIsInSubSet (pge_SetDesc to, unsigned int low, unsigned int high) -{ - if ((NumberOfElements (to, low, high)) == 1) - { - Output_Write ('('); - EmitIsInSet (to, low, high); - Output_Write (')'); - } - else if (low == 0) - { - /* avoid dangling else. */ - /* no need to check whether GetTokenType > low */ - Output_WriteString ((const char *) "((", 2); - WriteGetTokenType (); - Output_Write ('<'); - WriteElement (static_cast (((int ) (high))+1)); - Output_WriteString ((const char *) ") AND (", 7); - EmitIsInSet (to, low, high); - Output_WriteString ((const char *) "))", 2); - } - else if (((unsigned int ) (high)) > LargestValue) - { - /* avoid dangling else. */ - /* no need to check whether GetTokenType < high */ - Output_WriteString ((const char *) "((", 2); - WriteGetTokenType (); - Output_WriteString ((const char *) ">=", 2); - WriteElement (low); - Output_WriteString ((const char *) ") AND (", 7); - EmitIsInSet (to, low, high); - Output_WriteString ((const char *) "))", 2); - } - else - { - /* avoid dangling else. */ - Output_WriteString ((const char *) "((", 2); - WriteGetTokenType (); - Output_WriteString ((const char *) ">=", 2); - WriteElement (low); - Output_WriteString ((const char *) ") AND (", 7); - WriteGetTokenType (); - Output_Write ('<'); - WriteElement (static_cast (((int ) (high))+1)); - Output_WriteString ((const char *) ") AND (", 7); - EmitIsInSet (to, low, high); - Output_WriteString ((const char *) "))", 2); - } -} - - -/* - EmitIsInFirst - -*/ - -static void EmitIsInFirst (pge_SetDesc to, pge_m2condition m) -{ - unsigned int i; - unsigned int first; - - if ((NumberOfElements (to, static_cast (0), static_cast (0))) == 1) - { - /* only one element */ - WriteGetTokenType (); - Output_Write ('='); - EmitSet (to, static_cast (0), static_cast (0)); - } - else - { - if (LargestValue <= MaxElementsInSet) - { - Output_Write ('('); - WriteGetTokenType (); - Output_WriteString ((const char *) " IN ", 4); - EmitSetAsParameters (to); - Output_WriteString ((const char *) ")", 1); - } - else - { - i = 0; - first = TRUE; - do { - if (! (IsEmptySet (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1))) - { - if (! first) - { - Output_WriteString ((const char *) " OR", 3); - NewLine (Indent+(ConditionIndent (m))); - Indent -= ConditionIndent (m); - } - EmitIsInSubSet (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1); - first = FALSE; - } - i += 1; - } while (! ((i*MaxElementsInSet) > LargestValue)); - } - } -} - -static void FlushRecoverCode (pge_FactorDesc *codeStack) -{ - /* - FlushCode - - */ - if ((*codeStack) != NULL) - { - while ((*codeStack) != NULL) - { - EmitNonVarCode ((*codeStack)->code, 0, Indent); - (*codeStack) = (*codeStack)->pushed; - } - } -} - - -/* - RecoverFactor - -*/ - -static void RecoverFactor (pge_FactorDesc f, pge_m2condition m, pge_FactorDesc codeStack) -{ - pge_SetDesc to; - - if (f == NULL) - {} /* empty. */ - else - { - EmitFileLineTag (f->line); - switch (f->type) - { - case pge_id: - to = NULL; - CalcFirstFactor (f, NULL, &to); - if ((to != NULL) && (m != pge_m2none)) - { - RecoverCondition (m); - EmitIsInFirst (to, m); - CodeThenDo (m); - Indent += 3; - } - FlushRecoverCode (&codeStack); - IndentString ((const char *) "", 0); - Output_WriteKey (f->ident->name); - Output_Write ('('); - EmitStopParametersAndFollow (f, m); - Output_WriteString ((const char *) ") ;", 3); - Output_WriteLn (); - RecoverFactor (f->next, pge_m2none, codeStack); - if ((to != NULL) && (m != pge_m2none)) - { - Indent -= 3; - } - break; - - case pge_lit: - if (m == pge_m2none) - { - FlushRecoverCode (&codeStack); - IndentString ((const char *) "Expect(", 7); - Output_WriteKey (SymbolKey_GetSymKey (Aliases, f->string)); - Output_WriteString ((const char *) ", ", 2); - EmitStopParametersAndFollow (f, m); - Output_WriteString ((const char *) ") ;", 3); - Output_WriteLn (); - RecoverFactor (f->next, pge_m2none, codeStack); - } - else - { - RecoverCondition (m); - WriteGetTokenType (); - Output_Write ('='); - Output_WriteKey (SymbolKey_GetSymKey (Aliases, f->string)); - CodeThenDo (m); - Indent += 3; - IndentString ((const char *) "Expect(", 7); - Output_WriteKey (SymbolKey_GetSymKey (Aliases, f->string)); - Output_WriteString ((const char *) ", ", 2); - EmitStopParametersAndFollow (f, m); - Output_WriteString ((const char *) ") ;", 3); - Output_WriteLn (); - FlushRecoverCode (&codeStack); - RecoverFactor (f->next, pge_m2none, codeStack); - Indent -= 3; - } - break; - - case pge_sub: - FlushRecoverCode (&codeStack); - RecoverExpression (f->expr, pge_m2none, m); - RecoverFactor (f->next, pge_m2none, codeStack); - break; - - case pge_opt: - FlushRecoverCode (&codeStack); - if (OptExpSeen (f)) - { - to = NULL; - CalcFirstExpression (f->expr, NULL, &to); - RecoverCondition (m); - EmitIsInFirst (to, m); - CodeThenDo (m); - Indent += 3; - IndentString ((const char *) "(* seen optional [ | ] expression *)", 36); - Output_WriteLn (); - stop (); - RecoverExpression (f->expr, pge_m2none, pge_m2if); - IndentString ((const char *) "(* end of optional [ | ] expression *)", 38); - Output_WriteLn (); - Indent -= 3; - IndentString ((const char *) "END ;", 5); - Output_WriteLn (); - } - else - { - RecoverExpression (f->expr, pge_m2if, m); - } - RecoverFactor (f->next, pge_m2none, codeStack); - break; - - case pge_mult: - FlushRecoverCode (&codeStack); - if (((OptExpSeen (f)) || (m == pge_m2if)) || (m == pge_m2elsif)) - { - /* avoid dangling else. */ - to = NULL; - CalcFirstExpression (f->expr, NULL, &to); - RecoverCondition (m); - EmitIsInFirst (to, m); - CodeThenDo (m); - Indent += 3; - IndentString ((const char *) "(* seen optional { | } expression *)", 36); - Output_WriteLn (); - RecoverCondition (pge_m2while); - EmitIsInFirst (to, pge_m2while); - CodeThenDo (pge_m2while); - Indent += 3; - RecoverExpression (f->expr, pge_m2none, pge_m2while); - IndentString ((const char *) "(* end of optional { | } expression *)", 38); - Output_WriteLn (); - Indent -= 3; - IndentString ((const char *) "END ;", 5); - Output_WriteLn (); - Indent -= 3; - if (m == pge_m2none) - { - IndentString ((const char *) "END ;", 5); - Output_WriteLn (); - Indent -= 3; - } - } - else - { - RecoverExpression (f->expr, pge_m2while, m); - } - RecoverFactor (f->next, pge_m2none, codeStack); - break; - - case pge_m2: - codeStack = ChainOn (codeStack, f); - if (f->next == NULL) - { - FlushRecoverCode (&codeStack); - } - else - { - RecoverFactor (f->next, m, codeStack); /* was m2none */ - } - break; - - - default: - break; - } - } -} - - -/* - OptExpSeen - returns TRUE if we can see an optional expression in the factor. - This is not the same as epsilon. Example { '+' } matches epsilon as - well as { '+' | '-' } but OptExpSeen returns TRUE in the second case - and FALSE in the first. -*/ - -static unsigned int OptExpSeen (pge_FactorDesc f) -{ - if (f == NULL) - { - return FALSE; - } - else - { - switch (f->type) - { - case pge_id: - case pge_lit: - return FALSE; - break; - - case pge_sub: - return FALSE; /* is this correct? */ - break; - - case pge_opt: - case pge_mult: - return ((f->expr != NULL) && (f->expr->term != NULL)) && (f->expr->term->next != NULL); /* is this correct? */ - break; - - case pge_m2: - return TRUE; - break; - - - default: - break; - } - } - PushBackInput_WarnError ((const char *) "all cases were not handled", 26); - WasNoError = FALSE; - ReturnException ("m2/gm2-auto/pge.mod", 1, 7); - __builtin_unreachable (); -} - - -/* - RecoverTerm - -*/ - -static void RecoverTerm (pge_TermDesc t, pge_m2condition new_, pge_m2condition old) -{ - unsigned int LastWasM2Only; - unsigned int alternative; - pge_SetDesc to; - - LastWasM2Only = (t->factor->type == pge_m2) && (t->factor->next == NULL); /* does the factor only contain inline code? */ - to = NULL; - CalcFirstTerm (t, NULL, &to); - alternative = FALSE; - if (t->next != NULL) - { - new_ = pge_m2if; - } - while (t != NULL) - { - EmitFileLineTag (t->line); - LastWasM2Only = (t->factor->type == pge_m2) && (t->factor->next == NULL); - if ((t->factor->type == pge_m2) && (new_ == pge_m2elsif)) - { - new_ = pge_m2if; - IndentString ((const char *) "ELSE", 4); - Output_WriteLn (); - Indent += 3; - RecoverFactor (t->factor, pge_m2none, NULL); - alternative = FALSE; - } - else - { - RecoverFactor (t->factor, new_, NULL); - } - if (t->next != NULL) - { - new_ = pge_m2elsif; - alternative = TRUE; - } - t = t->next; - } - if ((new_ == pge_m2if) || (new_ == pge_m2elsif)) - { - if (alternative && (old != pge_m2while)) - { - IndentString ((const char *) "ELSE", 4); - Output_WriteLn (); - Indent += 3; - IndentString ((const char *) "", 0); - Output_WriteKey (ErrorProcArray); - Output_WriteString ((const char *) "('expecting one of: ", 20); - EmitSetName (to, static_cast (0), static_cast (0)); - Output_WriteString ((const char *) "')", 2); - Output_WriteLn (); - Indent -= 3; - } - else if (LastWasM2Only) - { - /* avoid dangling else. */ - Indent -= 3; - } - IndentString ((const char *) "END ;", 5); - Output_WriteLn (); - } - else if (new_ == pge_m2while) - { - /* avoid dangling else. */ - IndentString ((const char *) "END (* while *) ;", 17); - Output_WriteLn (); - } - else if (LastWasM2Only) - { - /* avoid dangling else. */ - Indent -= 3; - } -} - - -/* - RecoverExpression - -*/ - -static void RecoverExpression (pge_ExpressionDesc e, pge_m2condition new_, pge_m2condition old) -{ - if (e != NULL) - { - EmitFileLineTag (e->line); - RecoverTerm (e->term, new_, old); - } -} - - -/* - RecoverStatement - -*/ - -static void RecoverStatement (pge_StatementDesc s, pge_m2condition m) -{ - if (s != NULL) - { - EmitFileLineTag (s->line); - RecoverExpression (s->expr, m, pge_m2none); - } -} - - -/* - EmitFirstFactor - generate a list of all first tokens between the range: low..high. -*/ - -static void EmitFirstFactor (pge_FactorDesc f, unsigned int low, unsigned int high) -{ -} - - -/* - EmitUsed - -*/ - -static void EmitUsed (unsigned int wordno) -{ - if (! ((((1 << (wordno)) & (ParametersUsed)) != 0))) - { - Output_WriteString ((const char *) " (* <* unused *> *) ", 20); - } -} - - -/* - EmitStopParameters - generate the stop set. -*/ - -static void EmitStopParameters (unsigned int FormalParameters) -{ - unsigned int i; - - if (LargestValue <= MaxElementsInSet) - { - Output_WriteString ((const char *) "stopset", 7); - if (FormalParameters) - { - Output_WriteString ((const char *) ": SetOfStop", 11); - EmitUsed (0); - } - else - { - ParametersUsed |= (1 << (0 )); - } - } - else - { - i = 0; - do { - Output_WriteString ((const char *) "stopset", 7); - Output_WriteCard (i, 0); - if (FormalParameters) - { - Output_WriteString ((const char *) ": SetOfStop", 11); - Output_WriteCard (i, 0); - EmitUsed (i); - } - else - { - ParametersUsed |= (1 << (i )); - } - i += 1; - if ((i*MaxElementsInSet) < LargestValue) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (FormalParameters) - { - Output_WriteString ((const char *) "; ", 2); - } - else - { - Output_WriteString ((const char *) ", ", 2); - } - } - } while (! ((i*MaxElementsInSet) >= LargestValue)); - } -} - - -/* - IsBetween - returns TRUE if the value of the token, string, is - in the range: low..high -*/ - -static unsigned int IsBetween (NameKey_Name string, unsigned int low, unsigned int high) -{ - return ((SymbolKey_GetSymKey (Values, string)) >= low) && ((SymbolKey_GetSymKey (Values, string)) <= high); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IsEmptySet - returns TRUE if no elements exist in set, to, with values, low..high. -*/ - -static unsigned int IsEmptySet (pge_SetDesc to, unsigned int low, unsigned int high) -{ - while (to != NULL) - { - switch (to->type) - { - case pge_tokel: - if (IsBetween (to->string, low, high)) - { - return FALSE; - } - break; - - case pge_litel: - if (IsBetween (SymbolKey_GetSymKey (Aliases, to->string), low, high)) - { - return FALSE; - } - break; - - case pge_idel: - PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40); - WasNoError = FALSE; - break; - - - default: - PushBackInput_WarnError ((const char *) "unknown enuneration element", 27); - WasNoError = FALSE; - break; - } - to = to->next; - } - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EmitSet - emits the tokens in the set, to, which have values low..high -*/ - -static void EmitSet (pge_SetDesc to, unsigned int low, unsigned int high) -{ - unsigned int first; - - first = TRUE; - while (to != NULL) - { - switch (to->type) - { - case pge_tokel: - if ((high == 0) || (IsBetween (to->string, low, high))) - { - if (! first) - { - Output_WriteString ((const char *) ", ", 2); - } - Output_WriteKey (to->string); - first = FALSE; - } - break; - - case pge_litel: - if ((high == 0) || (IsBetween (SymbolKey_GetSymKey (Aliases, to->string), low, high))) - { - if (! first) - { - Output_WriteString ((const char *) ", ", 2); - } - Output_WriteKey (SymbolKey_GetSymKey (Aliases, to->string)); - first = FALSE; - } - break; - - case pge_idel: - PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40); - WasNoError = FALSE; - break; - - - default: - PushBackInput_WarnError ((const char *) "unknown enuneration element", 27); - WasNoError = FALSE; - break; - } - to = to->next; - } -} - - -/* - EmitSetName - emits the tokens in the set, to, which have values low..high, using - their names. -*/ - -static void EmitSetName (pge_SetDesc to, unsigned int low, unsigned int high) -{ - while (to != NULL) - { - switch (to->type) - { - case pge_tokel: - if ((high == 0) || (IsBetween (to->string, low, high))) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if ((NameKey_MakeKey ((const char *) "'", 1)) == (SymbolKey_GetSymKey (ReverseAliases, to->string))) - { - Output_WriteString ((const char *) "single quote", 12); - } - else - { - KeyWord (SymbolKey_GetSymKey (ReverseAliases, to->string)); - } - } - break; - - case pge_litel: - if ((high == 0) || (IsBetween (SymbolKey_GetSymKey (Aliases, to->string), low, high))) - { - Output_WriteKey (to->string); - } - break; - - case pge_idel: - PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40); - WasNoError = FALSE; - break; - - - default: - PushBackInput_WarnError ((const char *) "unknown enuneration element", 27); - WasNoError = FALSE; - break; - } - to = to->next; - if (to != NULL) - { - Output_Write (' '); - } - } -} - - -/* - EmitStopParametersAndSet - generates the stop parameters together with a set - inclusion of all the symbols in set, to. -*/ - -static void EmitStopParametersAndSet (pge_SetDesc to) -{ - unsigned int i; - - if (LargestValue <= MaxElementsInSet) - { - /* avoid dangling else. */ - Output_WriteString ((const char *) "stopset", 7); - ParametersUsed |= (1 << (0 )); - if ((to != NULL) && ((NumberOfElements (to, static_cast (0), static_cast (MaxElementsInSet-1))) > 0)) - { - Output_WriteString ((const char *) " + SetOfStop", 12); - Output_Write ('{'); - EmitSet (to, static_cast (0), static_cast (MaxElementsInSet-1)); - Output_Write ('}'); - } - } - else - { - i = 0; - do { - Output_WriteString ((const char *) "stopset", 7); - Output_WriteCard (i, 0); - ParametersUsed |= (1 << (i )); - if ((to != NULL) && ((NumberOfElements (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1)) > 0)) - { - Output_WriteString ((const char *) " + SetOfStop", 12); - Output_WriteCard (i, 0); - Output_Write ('{'); - EmitSet (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1); - Output_Write ('}'); - } - i += 1; - if ((i*MaxElementsInSet) < LargestValue) - { - Output_WriteString ((const char *) ", ", 2); - } - } while (! ((i*MaxElementsInSet) >= LargestValue)); - } -} - - -/* - EmitSetAsParameters - generates the first symbols as parameters to a set function. -*/ - -static void EmitSetAsParameters (pge_SetDesc to) -{ - unsigned int i; - - if (LargestValue <= MaxElementsInSet) - { - Output_Write ('{'); - EmitSet (to, static_cast (0), static_cast (MaxElementsInSet-1)); - } - else - { - i = 0; - do { - Output_Write ('{'); - EmitSet (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1); - i += 1; - if (((i+1)*MaxElementsInSet) > LargestValue) - { - Output_WriteString ((const char *) "}, ", 3); - } - } while (! (((i+1)*MaxElementsInSet) >= LargestValue)); - } - Output_Write ('}'); -} - - -/* - EmitStopParametersAndFollow - generates the stop parameters together with a set - inclusion of all the follow symbols for subsequent - sentances. -*/ - -static void EmitStopParametersAndFollow (pge_FactorDesc f, pge_m2condition m) -{ - pge_SetDesc to; - - to = NULL; - /* - IF m=m2while - THEN - CalcFirstFactor(f, NIL, to) - END ; - */ - CollectFollow (&to, f->followinfo); - EmitStopParametersAndSet (to); - if (Debugging) - { - Output_WriteLn (); - Output_WriteString ((const char *) "factor is: ", 11); - PrettyCommentFactor (f, StrLib_StrLen ((const char *) "factor is: ", 11)); - Output_WriteLn (); - Output_WriteString ((const char *) "follow set:", 11); - EmitSet (to, static_cast (0), static_cast (0)); - Output_WriteLn (); - } -} - - -/* - EmitFirstAsParameters - -*/ - -static void EmitFirstAsParameters (pge_FactorDesc f) -{ - pge_SetDesc to; - - to = NULL; - CalcFirstFactor (f, NULL, &to); - EmitSetAsParameters (to); -} - - -/* - RecoverProduction - only encode grammer rules which are not special. - Generate error recovery code. -*/ - -static void RecoverProduction (pge_ProductionDesc p) -{ - DynamicStrings_String s; - - if ((p != NULL) && (! p->firstsolved || ((p->statement != NULL) && (p->statement->expr != NULL)))) - { - BeginningOfLine = TRUE; - Indent = 0; - Output_WriteLn (); - OnLineStart = FALSE; - EmitFileLineTag (p->line); - IndentString ((const char *) "PROCEDURE ", 10); - Output_WriteKey (GetDefinitionName (p)); - Output_WriteString ((const char *) " (", 2); - ParametersUsed = (unsigned int) 0; - Output_StartBuffer (); - Output_WriteString ((const char *) ") ;", 3); - VarProduction (p); - Output_WriteLn (); - OnLineStart = FALSE; - EmitFileLineTag (p->line); - Indent = 0; - IndentString ((const char *) "BEGIN", 5); - Output_WriteLn (); - OnLineStart = FALSE; - EmitFileLineTag (p->line); - Indent = 3; - RecoverStatement (p->statement, pge_m2none); - Indent = 0; - IndentString ((const char *) "END ", 4); - Output_WriteKey (GetDefinitionName (p)); - Output_WriteString ((const char *) " ;", 2); - Output_WriteLn (); - Output_WriteLn (); - Output_WriteLn (); - s = Output_EndBuffer (); - EmitStopParameters (TRUE); - Output_KillWriteS (s); - } -} - - -/* - IsWhite - returns TRUE if, ch, is a space or a tab. -*/ - -static unsigned int IsWhite (char ch) -{ - return ((ch == ' ') || (ch == ASCII_tab)) || (ch == ASCII_lf); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - FindStr - returns TRUE if, str, was seen inside the code hunk -*/ - -static unsigned int FindStr (pge_CodeHunk *code, unsigned int *i, const char *str_, unsigned int _str_high) -{ - unsigned int j; - unsigned int k; - pge_CodeHunk t; - char str[_str_high+1]; - - /* make a local copy of each unbounded array. */ - memcpy (str, str_, _str_high+1); - - t = (*code); - k = (StrLib_StrLen ((const char *) &(*code)->codetext.array[0], MaxCodeHunkLength))+1; - while (t != NULL) - { - do { - while ((k > 0) && (IsWhite (t->codetext.array[k-1]))) - { - k -= 1; - } - if (k == 0) - { - t = t->next; - k = MaxCodeHunkLength+1; - } - } while (! ((t == NULL) || (! (IsWhite (t->codetext.array[k-1]))))); - /* found another word check it */ - if (t != NULL) - { - j = StrLib_StrLen ((const char *) str, _str_high); - (*i) = k; - while (((t != NULL) && (j > 0)) && ((str[j-1] == t->codetext.array[k-1]) || ((IsWhite (str[j-1])) && (IsWhite (t->codetext.array[k-1]))))) - { - j -= 1; - k -= 1; - if (j == 0) - { - /* found word remember position */ - (*code) = t; - } - if (k == 0) - { - t = t->next; - k = MaxCodeHunkLength+1; - } - } - if (k > 0) - { - k -= 1; - } - else - { - t = t->next; - } - } - } - return (t == NULL) && (j == 0); - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - WriteUpto - -*/ - -static void WriteUpto (pge_CodeHunk code, pge_CodeHunk upto, unsigned int limit) -{ - if (code != upto) - { - WriteUpto (code->next, upto, limit); - Output_WriteString ((const char *) &code->codetext.array[0], MaxCodeHunkLength); - } - else - { - while ((limit <= MaxCodeHunkLength) && (code->codetext.array[limit] != ASCII_nul)) - { - Output_Write (code->codetext.array[limit]); - limit += 1; - } - } -} - - -/* - CheckForVar - checks for any local variables which need to be emitted during - this production. -*/ - -static void CheckForVar (pge_CodeHunk code) -{ - unsigned int i; - pge_CodeHunk t; - - t = code; - if ((FindStr (&t, &i, (const char *) "VAR", 3)) && EmitCode) - { - if (! EmittedVar) - { - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "VAR", 3); - Indent += 3; - Output_WriteLn (); - EmittedVar = TRUE; - } - WriteUpto (code, t, i); - } -} - - -/* - VarFactor - -*/ - -static void VarFactor (pge_FactorDesc f) -{ - while (f != NULL) - { - switch (f->type) - { - case pge_id: - break; - - case pge_lit: - break; - - case pge_sub: - case pge_opt: - case pge_mult: - VarExpression (f->expr); - break; - - case pge_m2: - CheckForVar (f->code->code); - break; - - - default: - break; - } - f = f->next; - } -} - - -/* - VarTerm - -*/ - -static void VarTerm (pge_TermDesc t) -{ - while (t != NULL) - { - VarFactor (t->factor); - t = t->next; - } -} - - -/* - VarExpression - -*/ - -static void VarExpression (pge_ExpressionDesc e) -{ - if (e != NULL) - { - VarTerm (e->term); - } -} - - -/* - VarStatement - -*/ - -static void VarStatement (pge_StatementDesc s) -{ - if (s != NULL) - { - VarExpression (s->expr); - } -} - - -/* - VarProduction - writes out all variable declarations. -*/ - -static void VarProduction (pge_ProductionDesc p) -{ - EmittedVar = FALSE; - if (p != NULL) - { - VarStatement (p->statement); - } -} - - -/* - In - returns TRUE if token, s, is already in the set, to. -*/ - -static unsigned int In (pge_SetDesc to, NameKey_Name s) -{ - while (to != NULL) - { - switch (to->type) - { - case pge_idel: - if (s == to->ident->name) - { - return TRUE; - } - break; - - case pge_tokel: - case pge_litel: - if (s == to->string) - { - return TRUE; - } - break; - - - default: - PushBackInput_WarnError ((const char *) "internal error CASE type not known", 34); - WasNoError = FALSE; - break; - } - to = to->next; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - IntersectionIsNil - given two set lists, s1, s2, return TRUE if the - s1 * s2 = {} -*/ - -static unsigned int IntersectionIsNil (pge_SetDesc s1, pge_SetDesc s2) -{ - while (s1 != NULL) - { - switch (s1->type) - { - case pge_idel: - if (In (s2, s1->ident->name)) - { - return FALSE; - } - break; - - case pge_tokel: - case pge_litel: - if (In (s2, s1->string)) - { - return FALSE; - } - break; - - - default: - PushBackInput_WarnError ((const char *) "internal error CASE type not known", 34); - WasNoError = FALSE; - break; - } - s1 = s1->next; - } - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - AddSet - adds a first symbol to a production. -*/ - -static void AddSet (pge_SetDesc *to, NameKey_Name s) -{ - pge_SetDesc d; - - if (! (In ((*to), s))) - { - d = NewSetDesc (); - d->type = pge_tokel; - d->string = s; - d->next = (*to); - (*to) = d; - Finished = FALSE; - } -} - - -/* - OrSet - -*/ - -static void OrSet (pge_SetDesc *to, pge_SetDesc from) -{ - while (from != NULL) - { - switch (from->type) - { - case pge_tokel: - AddSet (to, from->string); - break; - - case pge_litel: - AddSet (to, SymbolKey_GetSymKey (Aliases, from->string)); - break; - - case pge_idel: - PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40); - WasNoError = FALSE; - break; - - - default: - Debug_Halt ((const char *) "unknown element in enumeration type", 35, 4122, (const char *) "m2/gm2-auto/pge.mod", 19); - break; - } - from = from->next; - } -} - - -/* - CalcFirstFactor - -*/ - -static void CalcFirstFactor (pge_FactorDesc f, pge_ProductionDesc from, pge_SetDesc *to) -{ - while (f != NULL) - { - switch (f->type) - { - case pge_id: - if (f->ident->definition == NULL) - { - WarnError1 ((const char *) "no rule found for an 'ident' called '%s'", 40, f->ident->name); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - OrSet (to, f->ident->definition->first); - if ((GetReachEnd (f->ident->definition->followinfo)) == pge_false) - { - return ; - } - break; - - case pge_lit: - if ((SymbolKey_GetSymKey (Aliases, f->string)) == SymbolKey_NulKey) - { - WarnError1 ((const char *) "unknown token for '%s'", 22, f->string); - WasNoError = FALSE; - } - else - { - AddSet (to, SymbolKey_GetSymKey (Aliases, f->string)); - } - return ; - break; - - case pge_sub: - case pge_opt: - case pge_mult: - CalcFirstExpression (f->expr, from, to); - break; - - case pge_m2: - break; - - - default: - break; - } - f = f->next; - } -} - - -/* - CalcFirstTerm - -*/ - -static void CalcFirstTerm (pge_TermDesc t, pge_ProductionDesc from, pge_SetDesc *to) -{ - while (t != NULL) - { - CalcFirstFactor (t->factor, from, to); - t = t->next; - } -} - - -/* - CalcFirstExpression - -*/ - -static void CalcFirstExpression (pge_ExpressionDesc e, pge_ProductionDesc from, pge_SetDesc *to) -{ - if (e != NULL) - { - CalcFirstTerm (e->term, from, to); - } -} - - -/* - CalcFirstStatement - -*/ - -static void CalcFirstStatement (pge_StatementDesc s, pge_ProductionDesc from, pge_SetDesc *to) -{ - if (s != NULL) - { - CalcFirstExpression (s->expr, from, to); - } -} - - -/* - CalcFirstProduction - calculates all of the first symbols for the grammer -*/ - -static void CalcFirstProduction (pge_ProductionDesc p, pge_ProductionDesc from, pge_SetDesc *to) -{ - pge_SetDesc s; - - if (p != NULL) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (p->firstsolved) - { - s = p->first; - while (s != NULL) - { - switch (s->type) - { - case pge_idel: - CalcFirstProduction (s->ident->definition, from, to); - break; - - case pge_tokel: - case pge_litel: - AddSet (to, s->string); - break; - - - default: - break; - } - s = s->next; - } - } - else - { - CalcFirstStatement (p->statement, from, to); - } - } -} - -static void WorkOutFollowFactor (pge_FactorDesc f, pge_SetDesc *followset, pge_SetDesc after) -{ - pge_TraverseResult foundepsilon; - pge_TraverseResult canreachend; - - /* - WorkOutFollow - - */ - foundepsilon = pge_true; - canreachend = pge_true; - while ((f != NULL) && (foundepsilon == pge_true)) - { - switch (f->type) - { - case pge_id: - if (f->ident->definition == NULL) - { - WarnError1 ((const char *) "no rule found for an 'ident' called '%s'", 40, f->ident->name); - M2RTS_HALT (-1); - __builtin_unreachable (); - } - OrSet (followset, f->ident->definition->first); - break; - - case pge_lit: - AddSet (followset, SymbolKey_GetSymKey (Aliases, f->string)); - break; - - case pge_sub: - WorkOutFollowExpression (f->expr, followset, NULL); - break; - - case pge_opt: - WorkOutFollowExpression (f->expr, followset, NULL); - break; - - case pge_mult: - WorkOutFollowExpression (f->expr, followset, NULL); - break; - - case pge_m2: - break; - - - default: - break; - } - if ((GetEpsilon (f->followinfo)) == pge_unknown) - { - PushBackInput_WarnError ((const char *) "internal error: epsilon unknown", 31); - PrettyCommentFactor (f, 3); - WasNoError = FALSE; - } - foundepsilon = GetEpsilon (f->followinfo); - canreachend = GetReachEnd (f->followinfo); /* only goes from FALSE -> TRUE */ - f = f->next; /* only goes from FALSE -> TRUE */ - } - if (canreachend == pge_true) - { - OrSet (followset, after); - } -} - - -/* - WorkOutFollowTerm - -*/ - -static void WorkOutFollowTerm (pge_TermDesc t, pge_SetDesc *followset, pge_SetDesc after) -{ - if (t != NULL) - { - while (t != NULL) - { - WorkOutFollowFactor (t->factor, followset, after); /* { '|' Term } */ - t = t->next; /* { '|' Term } */ - } - } -} - - -/* - WorkOutFollowExpression - -*/ - -static void WorkOutFollowExpression (pge_ExpressionDesc e, pge_SetDesc *followset, pge_SetDesc after) -{ - if (e != NULL) - { - WorkOutFollowTerm (e->term, followset, after); - } -} - - -/* - CollectFollow - collects the follow set from, f, into, to. -*/ - -static void CollectFollow (pge_SetDesc *to, pge_FollowDesc f) -{ - OrSet (to, f->follow); -} - - -/* - CalcFollowFactor - -*/ - -static void CalcFollowFactor (pge_FactorDesc f, pge_SetDesc after) -{ - while (f != NULL) - { - switch (f->type) - { - case pge_id: - WorkOutFollowFactor (f->next, &f->followinfo->follow, after); - break; - - case pge_lit: - WorkOutFollowFactor (f->next, &f->followinfo->follow, after); - break; - - case pge_opt: - case pge_sub: - CalcFirstFactor (f->next, NULL, &f->followinfo->follow); - if ((f->next == NULL) || ((GetReachEnd (f->next->followinfo)) == pge_true)) - { - OrSet (&f->followinfo->follow, after); - CalcFollowExpression (f->expr, f->followinfo->follow); - } - else - { - CalcFollowExpression (f->expr, f->followinfo->follow); - } - break; - - case pge_mult: - CalcFirstFactor (f, NULL, &f->followinfo->follow); - /* include first as we may repeat this sentance */ - if (Debugging) - { - StrIO_WriteLn (); - StrIO_WriteString ((const char *) "found mult: and first is: ", 26); - EmitSet (f->followinfo->follow, static_cast (0), static_cast (0)); - StrIO_WriteLn (); - } - if ((f->next == NULL) || ((GetReachEnd (f->next->followinfo)) == pge_true)) - { - OrSet (&f->followinfo->follow, after); - CalcFollowExpression (f->expr, f->followinfo->follow); - } - else - { - CalcFollowExpression (f->expr, f->followinfo->follow); - } - break; - - - default: - break; - } - f = f->next; - } -} - - -/* - CalcFollowTerm - -*/ - -static void CalcFollowTerm (pge_TermDesc t, pge_SetDesc after) -{ - if (t != NULL) - { - while (t != NULL) - { - CalcFollowFactor (t->factor, after); /* { '|' Term } */ - t = t->next; /* { '|' Term } */ - } - } -} - - -/* - CalcFollowExpression - -*/ - -static void CalcFollowExpression (pge_ExpressionDesc e, pge_SetDesc after) -{ - if (e != NULL) - { - CalcFollowTerm (e->term, after); - } -} - - -/* - CalcFollowStatement - given a bnf statement generate the follow set. -*/ - -static void CalcFollowStatement (pge_StatementDesc s) -{ - if (s != NULL) - { - CalcFollowExpression (s->expr, NULL); - } -} - - -/* - CalcFollowProduction - -*/ - -static void CalcFollowProduction (pge_ProductionDesc p) -{ - if (p != NULL) - { - CalcFollowStatement (p->statement); - } -} - - -/* - CalcEpsilonFactor - -*/ - -static void CalcEpsilonFactor (pge_FactorDesc f) -{ - while (f != NULL) - { - switch (f->type) - { - case pge_id: - AssignEpsilon ((GetEpsilon (f->ident->definition->followinfo)) != pge_unknown, f->followinfo, GetEpsilon (f->ident->definition->followinfo)); - break; - - case pge_lit: - AssignEpsilon (TRUE, f->followinfo, pge_false); - break; - - case pge_sub: - CalcEpsilonExpression (f->expr); - AssignEpsilon ((GetEpsilon (f->expr->followinfo)) != pge_unknown, f->followinfo, GetEpsilon (f->expr->followinfo)); - break; - - case pge_m2: - AssignEpsilon (TRUE, f->followinfo, pge_true); - break; - - case pge_opt: - case pge_mult: - CalcEpsilonExpression (f->expr); - AssignEpsilon (TRUE, f->followinfo, pge_true); - break; - - - default: - break; - } - f = f->next; - } -} - - -/* - CalcEpsilonTerm - -*/ - -static void CalcEpsilonTerm (pge_TermDesc t) -{ - if (t != NULL) - { - while (t != NULL) - { - if (t->factor != NULL) - { - switch (GetReachEnd (t->factor->followinfo)) - { - case pge_true: - AssignEpsilon (TRUE, t->followinfo, pge_true); - break; - - case pge_false: - AssignEpsilon (TRUE, t->followinfo, pge_false); - break; - - case pge_unknown: - break; - - - default: - break; - } - } - CalcEpsilonFactor (t->factor); /* { '|' Term } */ - t = t->next; - } - } -} - - -/* - CalcEpsilonExpression - -*/ - -static void CalcEpsilonExpression (pge_ExpressionDesc e) -{ - pge_TermDesc t; - pge_TraverseResult result; - - if (e != NULL) - { - CalcEpsilonTerm (e->term); - if ((GetEpsilon (e->followinfo)) == pge_unknown) - { - result = pge_unknown; - t = e->term; - while (t != NULL) - { - if ((GetEpsilon (t->followinfo)) != pge_unknown) - { - stop (); - } - switch (GetEpsilon (t->followinfo)) - { - case pge_unknown: - break; - - case pge_true: - result = pge_true; - break; - - case pge_false: - if (result != pge_true) - { - result = pge_false; - } - break; - - - default: - break; - } - t = t->next; - } - AssignEpsilon (result != pge_unknown, e->followinfo, result); - } - } -} - - -/* - CalcEpsilonStatement - given a bnf statement generate the follow set. -*/ - -static void CalcEpsilonStatement (pge_StatementDesc s) -{ - if (s != NULL) - { - if (s->expr != NULL) - { - AssignEpsilon ((GetEpsilon (s->expr->followinfo)) != pge_unknown, s->followinfo, GetEpsilon (s->expr->followinfo)); - } - CalcEpsilonExpression (s->expr); - } -} - - -/* - CalcEpsilonProduction - -*/ - -static void CalcEpsilonProduction (pge_ProductionDesc p) -{ - if (p != NULL) - { - /* - IF p^.statement^.ident^.name=MakeKey('DefinitionModule') - THEN - stop - END ; - */ - if (Debugging) - { - NameKey_WriteKey (p->statement->ident->name); - StrIO_WriteString ((const char *) " calculating epsilon", 21); - StrIO_WriteLn (); - } - AssignEpsilon ((GetEpsilon (p->statement->followinfo)) != pge_unknown, p->followinfo, GetEpsilon (p->statement->followinfo)); - CalcEpsilonStatement (p->statement); - } -} - - -/* - CalcReachEndFactor - -*/ - -static pge_TraverseResult CalcReachEndFactor (pge_FactorDesc f) -{ - pge_TraverseResult canreachend; - pge_TraverseResult result; - - if (f == NULL) - { - return pge_true; /* we have reached the end of this factor list */ - } - else - { - /* we need to traverse all factors even if we can short cut the answer to this list of factors */ - result = CalcReachEndFactor (f->next); - switch (f->type) - { - case pge_id: - if (f->ident->definition == NULL) - { - WarnError1 ((const char *) "definition for %s is absent (assuming epsilon is false for this production)", 75, f->ident->name); - result = pge_false; - } - else if (result != pge_false) - { - /* avoid dangling else. */ - switch (GetReachEnd (f->ident->definition->followinfo)) - { - case pge_false: - result = pge_false; - break; - - case pge_true: - break; - - case pge_unknown: - result = pge_unknown; - break; - - - default: - break; - } - } - break; - - case pge_lit: - result = pge_false; - break; - - case pge_sub: - CalcReachEndExpression (f->expr); - if ((f->expr != NULL) && (result == pge_true)) - { - result = GetReachEnd (f->expr->followinfo); - } - break; - - case pge_mult: - case pge_opt: - if (f->expr != NULL) - { - /* not interested in the result as expression is optional */ - CalcReachEndExpression (f->expr); - } - break; - - case pge_m2: - break; - - - default: - break; - } - AssignReachEnd (result != pge_unknown, f->followinfo, result); - return result; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CalcReachEndTerm - -*/ - -static pge_TraverseResult CalcReachEndTerm (pge_TermDesc t) -{ - pge_TraverseResult canreachend; - pge_TraverseResult result; - - if (t != NULL) - { - canreachend = pge_false; - while (t != NULL) - { - result = CalcReachEndFactor (t->factor); - AssignReachEnd (result != pge_unknown, t->followinfo, result); - switch (result) - { - case pge_true: - canreachend = pge_true; - break; - - case pge_false: - break; - - case pge_unknown: - if (canreachend == pge_false) - { - canreachend = pge_unknown; - } - break; - - - default: - break; - } - t = t->next; /* { '|' Term } */ - } - return canreachend; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CalcReachEndExpression - -*/ - -static void CalcReachEndExpression (pge_ExpressionDesc e) -{ - pge_TraverseResult result; - - if (e == NULL) - {} /* empty. */ - else - { - /* no expression, thus reached the end of this sentance */ - result = CalcReachEndTerm (e->term); - AssignReachEnd (result != pge_unknown, e->followinfo, result); - } -} - - -/* - CalcReachEndStatement - -*/ - -static void CalcReachEndStatement (pge_StatementDesc s) -{ - if (s != NULL) - { - if (s->expr != NULL) - { - CalcReachEndExpression (s->expr); - AssignReachEnd ((GetReachEnd (s->expr->followinfo)) != pge_unknown, s->followinfo, GetReachEnd (s->expr->followinfo)); - } - } -} - - -/* - CalcReachEndStatement - -*/ - -static void stop (void) -{ -} - - -/* - CalcReachEndProduction - -*/ - -static void CalcReachEndProduction (pge_ProductionDesc p) -{ - if (p != NULL) - { - CalcReachEndStatement (p->statement); - if ((GetReachEnd (p->followinfo)) != pge_unknown) - { - if (Debugging) - { - StrIO_WriteString ((const char *) "already calculated reach end for: ", 34); - NameKey_WriteKey (p->statement->ident->name); - StrIO_WriteString ((const char *) " its value is ", 14); - if ((GetReachEnd (p->followinfo)) == pge_true) - { - StrIO_WriteString ((const char *) "reachable", 9); - } - else - { - StrIO_WriteString ((const char *) "non reachable", 13); - } - StrIO_WriteLn (); - } - } - AssignReachEnd ((GetReachEnd (p->statement->followinfo)) != pge_unknown, p->followinfo, GetReachEnd (p->statement->followinfo)); - } -} - - -/* - EmptyFactor - -*/ - -static unsigned int EmptyFactor (pge_FactorDesc f) -{ - while (f != NULL) - { - switch (f->type) - { - case pge_id: - if (! (EmptyProduction (f->ident->definition))) - { - return FALSE; - } - break; - - case pge_lit: - return FALSE; - break; - - case pge_sub: - if (! (EmptyExpression (f->expr))) - { - return FALSE; - } - break; - - case pge_opt: - case pge_mult: - return TRUE; - break; - - case pge_m2: - break; - - - default: - break; - } - f = f->next; - } - return TRUE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EmptyTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int EmptyTerm (pge_TermDesc t) -{ - while (t != NULL) - { - if (EmptyFactor (t->factor)) - { - return TRUE; - } - else - { - t = t->next; - } - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EmptyExpression - -*/ - -static unsigned int EmptyExpression (pge_ExpressionDesc e) -{ - if (e == NULL) - { - return TRUE; - } - else - { - return EmptyTerm (e->term); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EmptyStatement - returns TRUE if statement, s, is empty. -*/ - -static unsigned int EmptyStatement (pge_StatementDesc s) -{ - if (s == NULL) - { - return TRUE; - } - else - { - return EmptyExpression (s->expr); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EmptyProduction - returns if production, p, maybe empty. -*/ - -static unsigned int EmptyProduction (pge_ProductionDesc p) -{ - if (p == NULL) - { - PushBackInput_WarnError ((const char *) "unknown production", 18); - return TRUE; - } - else if (p->firstsolved && (p->first != NULL)) - { - /* avoid dangling else. */ - /* predefined but first set to something - thus not empty */ - return FALSE; - } - else - { - /* avoid dangling else. */ - return EmptyStatement (p->statement); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - EmitFDLNotice - -*/ - -static void EmitFDLNotice (void) -{ - Output_WriteString ((const char *) "@c Copyright (C) 2000-2023 Free Software Foundation, Inc.", 57); - Output_WriteLn (); - Output_WriteLn (); - Output_WriteString ((const char *) "@c This file is part of GCC.", 28); - Output_WriteLn (); - Output_WriteString ((const char *) "@c Permission is granted to copy, distribute and/or modify this document", 72); - Output_WriteLn (); - Output_WriteString ((const char *) "@c under the terms of the GNU Free Documentation License, Version 1.2 or", 72); - Output_WriteLn (); - Output_WriteString ((const char *) "@c any later version published by the Free Software Foundation.", 63); - Output_WriteLn (); -} - - -/* - EmitRules - generates the BNF rules. -*/ - -static void EmitRules (void) -{ - if (Texinfo && FreeDocLicense) - { - EmitFDLNotice (); - } - ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) EmitRule}); -} - - -/* - DescribeElement - -*/ - -static void DescribeElement (unsigned int name) -{ - NameKey_Name lit; - - if (InitialElement) - { - InitialElement = FALSE; - } - else - { - Output_WriteString ((const char *) " |", 2); - } - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "", 0); - Output_WriteKey (name); - Output_WriteString ((const char *) ": ", 2); - lit = static_cast (SymbolKey_GetSymKey (ReverseAliases, name)); - if ((NameKey_MakeKey ((const char *) "\"", 1)) == lit) - { - Output_WriteString ((const char *) "str := ConCat(ConCatChar(ConCatChar(InitString(\"syntax error, found ", 68); - Output_Write ('\''); - Output_WriteString ((const char *) "\"), ", 4); - Output_Write ('\''); - Output_Write ('"'); - Output_Write ('\''); - Output_WriteString ((const char *) "), ", 3); - Output_Write ('"'); - Output_Write ('\''); - Output_Write ('"'); - Output_WriteString ((const char *) "), Mark(str))", 13); - } - else if ((NameKey_MakeKey ((const char *) "'", 1)) == lit) - { - /* avoid dangling else. */ - Output_WriteString ((const char *) "str := ConCat(ConCatChar(ConCatChar(InitString('syntax error, found ", 68); - Output_Write ('"'); - Output_WriteString ((const char *) "'), ", 4); - Output_Write ('"'); - Output_Write ('\''); - Output_Write ('"'); - Output_WriteString ((const char *) "), ", 3); - Output_Write ('\''); - Output_Write ('"'); - Output_Write ('\''); - Output_WriteString ((const char *) "), Mark(str))", 13); - } - else - { - /* avoid dangling else. */ - Output_WriteString ((const char *) "str := ConCat(InitString(", 25); - Output_Write ('"'); - Output_WriteString ((const char *) "syntax error, found ", 20); - KeyWord (lit); - Output_WriteString ((const char *) "\"), Mark(str))", 14); - } -} - - -/* - EmitInTestStop - construct a test for stop element, name. -*/ - -static void EmitInTestStop (NameKey_Name name) -{ - unsigned int i; - unsigned int value; - - if (LargestValue <= MaxElementsInSet) - { - Output_WriteKey (name); - Output_WriteString ((const char *) " IN stopset", 11); - ParametersUsed |= (1 << (0 )); - } - else - { - value = static_cast (SymbolKey_GetSymKey (Values, name)); - i = value / MaxElementsInSet; - Output_WriteKey (name); - Output_WriteString ((const char *) " IN stopset", 11); - Output_WriteCard (i, 0); - ParametersUsed |= (1 << (i )); - } -} - - -/* - DescribeStopElement - -*/ - -static void DescribeStopElement (unsigned int name) -{ - NameKey_Name lit; - - Indent = 3; - IndentString ((const char *) "IF ", 3); - EmitInTestStop (name); - Output_WriteLn (); - IndentString ((const char *) "THEN", 4); - Output_WriteLn (); - Indent = 6; - lit = static_cast (SymbolKey_GetSymKey (ReverseAliases, name)); - if ((lit == NameKey_NulName) || (lit == (NameKey_MakeKey ((const char *) "", 0)))) - { - IndentString ((const char *) "(* ", 3); - Output_WriteKey (name); - Output_WriteString ((const char *) " has no token name (needed to generate error messages) *)", 57); - } - else if ((NameKey_MakeKey ((const char *) "'", 1)) == lit) - { - /* avoid dangling else. */ - IndentString ((const char *) "message := ConCatChar(ConCatChar(ConCatChar(ConCatChar(ConCatChar(message, ", 75); - Output_WriteString ((const char *) "' '), ", 6); - Output_Write ('\''); - Output_Write ('"'); - Output_WriteString ((const char *) "'), ", 4); - Output_Write ('"'); - Output_Write ('\''); - Output_WriteString ((const char *) "\"), ", 4); - Output_Write ('\''); - Output_Write ('"'); - Output_WriteString ((const char *) "'), ',') ; INC(n) ; ", 20); - } - else if ((NameKey_MakeKey ((const char *) "\"", 1)) == lit) - { - /* avoid dangling else. */ - IndentString ((const char *) "message := ConCatChar(ConCatChar(ConCatChar(ConCatChar(ConCatChar(message, ", 75); - Output_WriteString ((const char *) "\" \"), ", 6); - Output_Write ('"'); - Output_Write ('`'); - Output_WriteString ((const char *) "\"), ", 4); - Output_Write ('\''); - Output_Write ('"'); - Output_WriteString ((const char *) "'), ", 4); - Output_Write ('"'); - Output_Write ('\''); - Output_WriteString ((const char *) "\"), \",\") ; INC(n) ; ", 20); - } - else - { - /* avoid dangling else. */ - IndentString ((const char *) "message := ConCat(ConCatChar(message, ' ", 40); - Output_WriteString ((const char *) "'), ", 4); - Output_WriteString ((const char *) "Mark(InitString(\"", 17); - KeyWord (lit); - Output_Write ('"'); - Output_WriteString ((const char *) "))) ; INC(n)", 12); - } - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "END ;", 5); - Output_WriteLn (); -} - - -/* - EmitDescribeStop - -*/ - -static void EmitDescribeStop (void) -{ - DynamicStrings_String s; - - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "(*", 2); - Indent = 3; - Output_WriteLn (); - IndentString ((const char *) "DescribeStop - issues a message explaining what tokens were expected", 68); - Output_WriteLn (); - Output_WriteString ((const char *) "*)", 2); - Output_WriteLn (); - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "PROCEDURE DescribeStop (", 24); - ParametersUsed = (unsigned int) 0; - Output_StartBuffer (); - Output_WriteString ((const char *) ") : String ;", 12); - Output_WriteLn (); - IndentString ((const char *) "VAR", 3); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "n : CARDINAL ;", 19); - Output_WriteLn (); - IndentString ((const char *) "str,", 4); - Output_WriteLn (); - IndentString ((const char *) "message: String ;", 17); - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "BEGIN", 5); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "n := 0 ;", 8); - Output_WriteLn (); - IndentString ((const char *) "message := InitString('') ;", 27); - Output_WriteLn (); - SymbolKey_ForeachNodeDo (Aliases, (SymbolKey_PerformOperation) {(SymbolKey_PerformOperation_t) DescribeStopElement}); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "IF n=0", 6); - Output_WriteLn (); - IndentString ((const char *) "THEN", 4); - Output_WriteLn (); - Indent = 6; - IndentString ((const char *) "str := InitString(' syntax error') ; ", 37); - Output_WriteLn (); - IndentString ((const char *) "message := KillString(message) ; ", 33); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "ELSIF n=1", 9); - Output_WriteLn (); - IndentString ((const char *) "THEN", 4); - Output_WriteLn (); - Indent = 6; - IndentString ((const char *) "str := ConCat(message, Mark(InitString(' missing '))) ;", 55); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "ELSE", 4); - Output_WriteLn (); - Indent = 6; - IndentString ((const char *) "str := ConCat(InitString(' expecting one of'), message) ;", 57); - Output_WriteLn (); - IndentString ((const char *) "message := KillString(message) ;", 32); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "END ;", 5); - Output_WriteLn (); - IndentString ((const char *) "RETURN( str )", 13); - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "END DescribeStop ;", 18); - Output_WriteLn (); - Output_WriteLn (); - s = Output_EndBuffer (); - EmitStopParameters (TRUE); - Output_KillWriteS (s); -} - - -/* - EmitDescribeError - -*/ - -static void EmitDescribeError (void) -{ - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "(*", 2); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "DescribeError - issues a message explaining what tokens were expected", 69); - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "*)", 2); - Output_WriteLn (); - Output_WriteLn (); - IndentString ((const char *) "PROCEDURE DescribeError ;", 25); - Output_WriteLn (); - IndentString ((const char *) "VAR", 3); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "str: String ;", 13); - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "BEGIN", 5); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "str := InitString('') ;", 23); - Output_WriteLn (); - /* was - IndentString('str := DescribeStop(') ; EmitStopParameters(FALSE) ; Output.WriteString(') ;') ; Output.WriteLn ; - */ - IndentString ((const char *) "CASE ", 5); - WriteGetTokenType (); - Output_WriteString ((const char *) " OF", 3); - NewLine (3); - InitialElement = TRUE; - SymbolKey_ForeachNodeDo (Aliases, (SymbolKey_PerformOperation) {(SymbolKey_PerformOperation_t) DescribeElement}); - Output_WriteLn (); - Indent = 3; - IndentString ((const char *) "ELSE", 4); - Output_WriteLn (); - IndentString ((const char *) "END ;", 5); - Output_WriteLn (); - IndentString ((const char *) "", 0); - Output_WriteKey (ErrorProcString); - Output_WriteString ((const char *) "(str) ;", 7); - Output_WriteLn (); - Indent = 0; - IndentString ((const char *) "END DescribeError ;", 19); - Output_WriteLn (); -} - - -/* - EmitSetTypes - write out the set types used during error recovery -*/ - -static void EmitSetTypes (void) -{ - unsigned int i; - unsigned int j; - unsigned int m; - unsigned int n; - - Output_WriteString ((const char *) "(*", 2); - NewLine (3); - Output_WriteString ((const char *) "expecting token set defined as an enumerated type", 49); - NewLine (3); - Output_WriteString ((const char *) "(", 1); - i = 0; - while (i < LargestValue) - { - Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (i))); - i += 1; - if (i < LargestValue) - { - Output_WriteString ((const char *) ", ", 2); - } - } - Output_WriteString ((const char *) ") ;", 3); - NewLine (0); - Output_WriteString ((const char *) "*)", 2); - NewLine (0); - Output_WriteString ((const char *) "TYPE", 4); - NewLine (3); - if (LargestValue > MaxElementsInSet) - { - i = 0; - n = LargestValue / MaxElementsInSet; - while (i <= n) - { - j = i*MaxElementsInSet; - if (LargestValue < (((i+1)*MaxElementsInSet)-1)) - { - m = LargestValue-1; - } - else - { - m = ((i+1)*MaxElementsInSet)-1; - } - Output_WriteString ((const char *) "stop", 4); - Output_WriteCard (i, 0); - Output_WriteString ((const char *) " = [", 4); - Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (j))); - Output_WriteString ((const char *) "..", 2); - Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (m))); - Output_WriteString ((const char *) "] ;", 3); - NewLine (3); - Output_WriteString ((const char *) "SetOfStop", 9); - Output_WriteCard (i, 0); - Output_WriteString ((const char *) " = SET OF stop", 14); - Output_WriteCard (i, 0); - Output_WriteString ((const char *) " ;", 2); - NewLine (3); - i += 1; - } - } - else - { - Output_WriteString ((const char *) "SetOfStop", 9); - Output_WriteString ((const char *) " = SET OF [", 11); - Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (0))); - Output_WriteString ((const char *) "..", 2); - Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (LargestValue-1))); - Output_WriteString ((const char *) "] ;", 3); - } - NewLine (0); -} - - -/* - EmitSupport - generates the support routines. -*/ - -static void EmitSupport (void) -{ - if (ErrorRecovery) - { - EmitSetTypes (); - EmitDescribeStop (); - EmitDescribeError (); - } -} - - -/* - DisposeSetDesc - dispose of the set list, s. -*/ - -static void DisposeSetDesc (pge_SetDesc *s) -{ - pge_SetDesc h; - pge_SetDesc n; - - if ((*s) != NULL) - { - h = (*s); - n = (*s)->next; - do { - Storage_DEALLOCATE ((void **) &h, sizeof (pge__T7)); - h = n; - if (n != NULL) - { - n = n->next; - } - } while (! (h == NULL)); - (*s) = NULL; - } -} - - -/* - OptionalFactor - -*/ - -static unsigned int OptionalFactor (pge_FactorDesc f) -{ - while (f != NULL) - { - switch (f->type) - { - case pge_id: - break; - - case pge_lit: - break; - - case pge_sub: - case pge_opt: - case pge_mult: - if (OptionalExpression (f->expr)) - { - return TRUE; - } - break; - - case pge_m2: - break; - - - default: - break; - } - f = f->next; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OptionalTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int OptionalTerm (pge_TermDesc t) -{ - pge_TermDesc u; - pge_TermDesc v; - pge_SetDesc tov; - pge_SetDesc tou; - - u = t; - while (u != NULL) - { - if (OptionalFactor (u->factor)) - { - return TRUE; - } - v = t; - tou = NULL; - CalcFirstFactor (u->factor, NULL, &tou); - while (v != NULL) - { - if (v != u) - { - tov = NULL; - CalcFirstFactor (v->factor, NULL, &tov); - if (IntersectionIsNil (tov, tou)) - { - DisposeSetDesc (&tov); - } - else - { - StrIO_WriteString ((const char *) "problem with two first sets. Set 1: ", 36); - EmitSet (tou, static_cast (0), static_cast (0)); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " Set 2: ", 36); - EmitSet (tov, static_cast (0), static_cast (0)); - StrIO_WriteLn (); - DisposeSetDesc (&tou); - DisposeSetDesc (&tov); - return TRUE; - } - } - v = v->next; - } - DisposeSetDesc (&tou); - u = u->next; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OptionalExpression - -*/ - -static unsigned int OptionalExpression (pge_ExpressionDesc e) -{ - if (e == NULL) - { - return FALSE; - } - else - { - return OptionalTerm (e->term); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OptionalStatement - returns FALSE if statement, s, does not have a optional ambiguity. -*/ - -static unsigned int OptionalStatement (pge_StatementDesc s) -{ - if (s == NULL) - { - return FALSE; - } - else - { - return OptionalExpression (s->expr); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - OptionalProduction - -*/ - -static unsigned int OptionalProduction (pge_ProductionDesc p) -{ - if (p == NULL) - { - return FALSE; - } - else - { - return OptionalStatement (p->statement); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - CheckFirstFollow - -*/ - -static unsigned int CheckFirstFollow (pge_FactorDesc f, pge_FactorDesc after) -{ - pge_SetDesc first; - pge_SetDesc follow; - - first = NULL; - CalcFirstFactor (f, NULL, &first); - follow = NULL; - follow = GetFollow (f->followinfo); - if (IntersectionIsNil (first, follow)) - { - DisposeSetDesc (&first); - DisposeSetDesc (&follow); - return FALSE; - } - else - { - PrettyCommentFactor (f, 3); - NewLine (3); - StrIO_WriteString ((const char *) "first: ", 7); - EmitSet (first, static_cast (0), static_cast (0)); - NewLine (3); - StrIO_WriteString ((const char *) "follow: ", 8); - EmitSet (follow, static_cast (0), static_cast (0)); - NewLine (3); - DisposeSetDesc (&first); - DisposeSetDesc (&follow); - return TRUE; - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConstrainedEmptyFactor - -*/ - -static unsigned int ConstrainedEmptyFactor (pge_FactorDesc f) -{ - while (f != NULL) - { - switch (f->type) - { - case pge_id: - break; - - case pge_lit: - break; - - case pge_sub: - case pge_opt: - case pge_mult: - if (ConstrainedEmptyExpression (f->expr)) - { - return TRUE; - } - break; - - case pge_m2: - break; - - - default: - break; - } - if (((f->type != pge_m2) && (EmptyFactor (f))) && (CheckFirstFollow (f, f->next))) - { - return TRUE; - } - f = f->next; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConstrainedEmptyTerm - returns TRUE if the term maybe empty. -*/ - -static unsigned int ConstrainedEmptyTerm (pge_TermDesc t) -{ - pge_SetDesc first; - pge_SetDesc follow; - - while (t != NULL) - { - if (ConstrainedEmptyFactor (t->factor)) - { - return TRUE; - } - else if (((t->factor->type != pge_m2) && (EmptyFactor (t->factor))) && (CheckFirstFollow (t->factor, t->factor->next))) - { - /* avoid dangling else. */ - return TRUE; - } - t = t->next; - } - return FALSE; - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConstrainedEmptyExpression - -*/ - -static unsigned int ConstrainedEmptyExpression (pge_ExpressionDesc e) -{ - if (e == NULL) - { - return FALSE; - } - else - { - return ConstrainedEmptyTerm (e->term); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConstrainedEmptyStatement - returns FALSE if statement, s, does not have a optional ambiguity. -*/ - -static unsigned int ConstrainedEmptyStatement (pge_StatementDesc s) -{ - if (s == NULL) - { - return FALSE; - } - else - { - return ConstrainedEmptyExpression (s->expr); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - ConstrainedEmptyProduction - returns TRUE if a problem exists with, p. -*/ - -static unsigned int ConstrainedEmptyProduction (pge_ProductionDesc p) -{ - if (p == NULL) - { - return FALSE; - } - else - { - return ConstrainedEmptyStatement (p->statement); - } - /* static analysis guarentees a RETURN statement will be used before here. */ - __builtin_unreachable (); -} - - -/* - TestForLALR1 - -*/ - -static void TestForLALR1 (pge_ProductionDesc p) -{ - if (OptionalProduction (p)) - { - WarnError1 ((const char *) "production %s has two optional sentances using | which both have the same start symbols", 87, p->statement->ident->name); - WasNoError = FALSE; - PrettyCommentProduction (p); - } -} - - -/* - DoEpsilon - runs the epsilon interrelated rules -*/ - -static void DoEpsilon (pge_ProductionDesc p) -{ - CalcEpsilonProduction (p); - CalcReachEndProduction (p); -} - - -/* - CheckComplete - checks that production, p, is complete. -*/ - -static void CheckComplete (pge_ProductionDesc p) -{ - if ((GetReachEnd (p->followinfo)) == pge_unknown) - { - PrettyCommentProduction (p); - WarnError1 ((const char *) "cannot determine epsilon, probably a left recursive rule in %s and associated rules (hint rewrite using ebnf and eliminate left recursion)", 138, p->statement->ident->name); - WasNoError = FALSE; - } -} - - -/* - PostProcessRules - backpatch the ident to rule definitions and emit comments and code. -*/ - -static void PostProcessRules (void) -{ - ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) BackPatchIdentToDefinitions}); - if (! WasNoError) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - WhileNotCompleteDo ((pge_DoProcedure) {(pge_DoProcedure_t) DoEpsilon}); - if (! WasNoError) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) CheckComplete}); - if (! WasNoError) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - WhileNotCompleteDo ((pge_DoProcedure) {(pge_DoProcedure_t) CalculateFirstAndFollow}); - if (! WasNoError) - { - M2RTS_HALT (-1); - __builtin_unreachable (); - } - ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) TestForLALR1}); - if (! WasNoError) - { - ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) PrettyCommentProduction}); - } -} - - -/* - DisplayHelp - display a summary help and then exit (0). -*/ - -static void DisplayHelp (void) -{ - StrIO_WriteString ((const char *) "Usage: pge [-l] [-c] [-d] [-e] [-k] [-t] [-k] [-p] [-x] [-f] [-o outputfile] filename", 85); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -l suppress file and line source information", 59); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -c do not generate any Modula-2 code within the parser rules", 75); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -h or --help generate this help message", 44); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -e do not generate a parser with error recovery", 62); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -k generate keyword errors with GCC formatting directives", 72); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -d generate internal debugging information", 57); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -p only display the ebnf rules", 45); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -t generate texinfo formating for pretty printing (-p)", 69); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -x generate sphinx formating for pretty printing (-p)", 68); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -f generate GNU Free Documentation header before pretty printing in texinfo", 90); - StrIO_WriteLn (); - StrIO_WriteString ((const char *) " -o write output to filename", 42); - StrIO_WriteLn (); - libc_exit (0); -} - - -/* - ParseArgs - -*/ - -static void ParseArgs (void) -{ - unsigned int n; - unsigned int i; - - ErrorRecovery = TRUE; /* DefaultRecovery ; */ - Debugging = FALSE; /* DefaultRecovery ; */ - PrettyPrint = FALSE; - KeywordFormatting = FALSE; - i = 1; - n = Args_Narg (); - while (i < n) - { - if (Args_GetArg ((char *) &ArgName.array[0], MaxFileName, i)) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-e", 2)) - { - ErrorRecovery = FALSE; - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-d", 2)) - { - /* avoid dangling else. */ - Debugging = TRUE; - bnflex_SetDebugging (TRUE); - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-c", 2)) - { - /* avoid dangling else. */ - EmitCode = FALSE; - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-k", 2)) - { - /* avoid dangling else. */ - KeywordFormatting = TRUE; - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-l", 2)) - { - /* avoid dangling else. */ - SuppressFileLineTag = TRUE; - } - else if ((StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-h", 2)) || (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "--help", 6))) - { - /* avoid dangling else. */ - DisplayHelp (); - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-p", 2)) - { - /* avoid dangling else. */ - PrettyPrint = TRUE; - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-t", 2)) - { - /* avoid dangling else. */ - Texinfo = TRUE; - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-x", 2)) - { - /* avoid dangling else. */ - Sphinx = TRUE; - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-f", 2)) - { - /* avoid dangling else. */ - FreeDocLicense = TRUE; - } - else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-o", 2)) - { - /* avoid dangling else. */ - i += 1; - if (Args_GetArg ((char *) &ArgName.array[0], MaxFileName, i)) - { - if (! (Output_Open ((const char *) &ArgName.array[0], MaxFileName))) - { - StrIO_WriteString ((const char *) "cannot open ", 12); - StrIO_WriteString ((const char *) &ArgName.array[0], MaxFileName); - StrIO_WriteString ((const char *) " for writing", 12); - StrIO_WriteLn (); - libc_exit (1); - } - } - } - else if (bnflex_OpenSource ((const char *) &ArgName.array[0], MaxFileName)) - { - /* avoid dangling else. */ - StrLib_StrCopy ((const char *) &ArgName.array[0], MaxFileName, (char *) &FileName.array[0], MaxFileName); - bnflex_AdvanceToken (); - } - else - { - /* avoid dangling else. */ - StrIO_WriteString ((const char *) "cannot open ", 12); - StrIO_WriteString ((const char *) &ArgName.array[0], MaxFileName); - StrIO_WriteString ((const char *) " for reading", 12); - StrIO_WriteLn (); - libc_exit (1); - } - } - i += 1; - } - if (n == 1) - { - DisplayHelp (); - } -} - - -/* - Init - initialize the modules data structures -*/ - -static void Init (void) -{ - WasNoError = TRUE; - Texinfo = FALSE; - Sphinx = FALSE; - FreeDocLicense = FALSE; - EmitCode = TRUE; - LargestValue = 0; - HeadProduction = NULL; - CurrentProduction = NULL; - SymbolKey_InitTree (&Aliases); - SymbolKey_InitTree (&ReverseAliases); - SymbolKey_InitTree (&Values); - SymbolKey_InitTree (&ReverseValues); - LastLineNo = 0; - CodePrologue = NULL; - CodeEpilogue = NULL; - CodeDeclaration = NULL; - ErrorProcArray = NameKey_MakeKey ((const char *) "Error", 5); - ErrorProcString = NameKey_MakeKey ((const char *) "ErrorS", 6); - TokenTypeProc = NameKey_MakeKey ((const char *) "GetCurrentTokenType()", 21); - SymIsProc = NameKey_MakeKey ((const char *) "SymIs", 5); - OnLineStart = TRUE; - ParseArgs (); - Main (static_cast ((unsigned int) ((1 << (bnflex_eoftok))))); /* this line will be manipulated by sed in buildpg */ - if (WasNoError) /* this line will be manipulated by sed in buildpg */ - { - PostProcessRules (); - if (WasNoError) - { - /* avoid gcc warning by using compound statement even if not strictly necessary. */ - if (Debugging) - { - EmitRules (); - } - else if (PrettyPrint) - { - /* avoid dangling else. */ - EmitRules (); - } - else - { - /* avoid dangling else. */ - Output_WriteString ((const char *) "(* it is advisable not to edit this file as it was automatically generated from the grammer file ", 97); - Output_WriteString ((const char *) &FileName.array[0], MaxFileName); - Output_WriteString ((const char *) " *)", 3); - Output_WriteLn (); - OnLineStart = FALSE; - EmitFileLineTag (LinePrologue); - BeginningOfLine = TRUE; - WriteCodeHunkList (CodePrologue); - EmitSupport (); - EmitFileLineTag (LineDeclaration); - WriteCodeHunkList (CodeDeclaration); - EmitRules (); - /* code rules */ - EmitFileLineTag (LineEpilogue); - WriteCodeHunkList (CodeEpilogue); - } - } - } - Output_Close (); -} - -extern "C" void _M2_pge_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ - Init (); -} - -extern "C" void _M2_pge_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) -{ -} diff --git a/gcc/m2/pge-boot/Gwrapc.c b/gcc/m2/pge-boot/Gwrapc.c deleted file mode 100644 index 7c3a431f856c..000000000000 --- a/gcc/m2/pge-boot/Gwrapc.c +++ /dev/null @@ -1,183 +0,0 @@ -/* Gwrapc.c wrap libc functions for mc. - -Copyright (C) 2005-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - -#include "config.h" -#include "system.h" -#include "ansidecl.h" - -#include "gm2-libs-host.h" - -#ifdef __cplusplus -extern "C" { -#endif - -/* strtime returns the address of a string which describes the - local time. */ - -char * -wrapc_strtime (void) -{ -#if defined(HAVE_CTIME) - time_t clock = time ((time_t *)0); - char *string = ctime (&clock); - - string[24] = (char)0; - - return string; -#else - return ""; -#endif -} - -int -wrapc_filesize (int f, unsigned int *low, unsigned int *high) -{ - struct stat s; - int res = fstat (f, (struct stat *)&s); - - if (res == 0) - { - *low = (unsigned int)s.st_size; - *high = (unsigned int)(s.st_size >> (sizeof (unsigned int) * 8)); - } - return res; -} - -/* filemtime returns the mtime of a file, f. */ - -int -wrapc_filemtime (int f) -{ - struct stat s; - - if (fstat (f, (struct stat *)&s) == 0) - return s.st_mtime; - else - return -1; -} - -/* getrand returns a random number between 0..n-1 */ - -int -wrapc_getrand (int n) -{ - return rand () % n; -} - -#if defined(HAVE_PWD_H) -#include - -char * -wrapc_getusername (void) -{ - return getpwuid (getuid ())->pw_gecos; -} - -/* getnameuidgid fills in the, uid, and, gid, which represents - user, name. */ - -void -wrapc_getnameuidgid (char *name, int *uid, int *gid) -{ - struct passwd *p = getpwnam (name); - - if (p == NULL) - { - *uid = -1; - *gid = -1; - } - else - { - *uid = p->pw_uid; - *gid = p->pw_gid; - } -} -#else -char * -wrapc_getusername (void) -{ - return "unknown"; -} - -void -wrapc_getnameuidgid (char *name, int *uid, int *gid) -{ - *uid = -1; - *gid = -1; -} -#endif - -int -wrapc_signbit (double r) -{ -#if defined(HAVE_SIGNBIT) - - /* signbit is a macro which tests its argument against sizeof(float), - sizeof(double). */ - return signbit (r); -#else - return 0; -#endif -} - -int -wrapc_signbitl (long double r) -{ -#if defined(HAVE_SIGNBITL) - - /* signbit is a macro which tests its argument against sizeof(float), - sizeof(double). */ - return signbitl (r); -#else - return 0; -#endif -} - -int -wrapc_signbitf (float r) -{ -#if defined(HAVE_SIGNBITF) - - /* signbit is a macro which tests its argument against sizeof(float), - sizeof(double). */ - return signbitf (r); -#else - return 0; -#endif -} - -/* init constructor for the module. */ - -void -_M2_wrapc_init () -{ -} - -/* finish deconstructor for the module. */ - -void -_M2_wrapc_finish () -{ -} - -#ifdef __cplusplus -} -#endif diff --git a/gcc/m2/pge-boot/README b/gcc/m2/pge-boot/README index 0281636c44dc..d678be303ce6 100644 --- a/gcc/m2/pge-boot/README +++ b/gcc/m2/pge-boot/README @@ -1,2 +1,4 @@ -This directory contains the hand built C wrappers required to allow the -libraries of mc to access the underlying host operating system. \ No newline at end of file +This directory contains a bootstrap C++ version of pge. +Do not edit this code - the source is in Modula-2 +the library modules to pge are found in gcc/m2/gm2-libs +and the program module is found in gcc/m2/gm2-compiler/ppg.mod. diff --git a/gcc/m2/pge-boot/main.c b/gcc/m2/pge-boot/main.c deleted file mode 100644 index b6f29f628f74..000000000000 --- a/gcc/m2/pge-boot/main.c +++ /dev/null @@ -1,123 +0,0 @@ -extern "C" void _M2_RTExceptions_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_RTExceptions_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_M2EXCEPTION_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_M2EXCEPTION_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_M2RTS_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_M2RTS_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_SysExceptions_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_SysExceptions_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_StrLib_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_StrLib_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_errno_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_errno_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_termios_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_termios_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_IO_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_IO_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_StdIO_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_StdIO_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Debug_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Debug_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_SysStorage_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_SysStorage_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Storage_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Storage_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_StrIO_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_StrIO_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_DynamicStrings_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_DynamicStrings_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Assertion_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Assertion_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Indexing_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Indexing_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_NameKey_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_NameKey_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_NumberIO_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_NumberIO_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_PushBackInput_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_PushBackInput_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_SymbolKey_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_SymbolKey_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_UnixArgs_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_UnixArgs_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_FIO_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_FIO_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_SFIO_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_SFIO_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_StrCase_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_StrCase_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_bnflex_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_bnflex_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Lists_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Lists_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Args_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Args_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Output_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_Output_fini (int argc, char *argv[], char *envp[]); -extern "C" void _M2_pge_init (int argc, char *argv[], char *envp[]); -extern "C" void _M2_pge_fini (int argc, char *argv[], char *envp[]); -extern "C" void _exit(int); - - -int main(int argc, char *argv[], char *envp[]) -{ - _M2_RTExceptions_init (argc, argv, envp); - _M2_M2EXCEPTION_init (argc, argv, envp); - _M2_M2RTS_init (argc, argv, envp); - _M2_SysExceptions_init (argc, argv, envp); - _M2_StrLib_init (argc, argv, envp); - _M2_errno_init (argc, argv, envp); - _M2_termios_init (argc, argv, envp); - _M2_IO_init (argc, argv, envp); - _M2_StdIO_init (argc, argv, envp); - _M2_Debug_init (argc, argv, envp); - _M2_SysStorage_init (argc, argv, envp); - _M2_Storage_init (argc, argv, envp); - _M2_StrIO_init (argc, argv, envp); - _M2_DynamicStrings_init (argc, argv, envp); - _M2_Assertion_init (argc, argv, envp); - _M2_Indexing_init (argc, argv, envp); - _M2_NameKey_init (argc, argv, envp); - _M2_NumberIO_init (argc, argv, envp); - _M2_PushBackInput_init (argc, argv, envp); - _M2_SymbolKey_init (argc, argv, envp); - _M2_UnixArgs_init (argc, argv, envp); - _M2_FIO_init (argc, argv, envp); - _M2_SFIO_init (argc, argv, envp); - _M2_StrCase_init (argc, argv, envp); - _M2_bnflex_init (argc, argv, envp); - _M2_Lists_init (argc, argv, envp); - _M2_Args_init (argc, argv, envp); - _M2_Output_init (argc, argv, envp); - _M2_pge_init (argc, argv, envp); - _M2_pge_fini (argc, argv, envp); - _M2_Output_fini (argc, argv, envp); - _M2_Args_fini (argc, argv, envp); - _M2_Lists_fini (argc, argv, envp); - _M2_bnflex_fini (argc, argv, envp); - _M2_StrCase_fini (argc, argv, envp); - _M2_SFIO_fini (argc, argv, envp); - _M2_FIO_fini (argc, argv, envp); - _M2_UnixArgs_fini (argc, argv, envp); - _M2_SymbolKey_fini (argc, argv, envp); - _M2_PushBackInput_fini (argc, argv, envp); - _M2_NumberIO_fini (argc, argv, envp); - _M2_NameKey_fini (argc, argv, envp); - _M2_Indexing_fini (argc, argv, envp); - _M2_Assertion_fini (argc, argv, envp); - _M2_DynamicStrings_fini (argc, argv, envp); - _M2_StrIO_fini (argc, argv, envp); - _M2_Storage_fini (argc, argv, envp); - _M2_SysStorage_fini (argc, argv, envp); - _M2_Debug_fini (argc, argv, envp); - _M2_StdIO_fini (argc, argv, envp); - _M2_IO_fini (argc, argv, envp); - _M2_termios_fini (argc, argv, envp); - _M2_errno_fini (argc, argv, envp); - _M2_StrLib_fini (argc, argv, envp); - _M2_SysExceptions_fini (argc, argv, envp); - _M2_M2RTS_fini (argc, argv, envp); - _M2_M2EXCEPTION_fini (argc, argv, envp); - _M2_RTExceptions_fini (argc, argv, envp); - return(0); -} diff --git a/gcc/m2/pge-boot/network.c b/gcc/m2/pge-boot/network.c deleted file mode 100644 index c2873f9de140..000000000000 --- a/gcc/m2/pge-boot/network.c +++ /dev/null @@ -1,40 +0,0 @@ -/* network.c provide access to htons and htonl. - -Copyright (C) 2010-2023 Free Software Foundation, Inc. -Contributed by Gaius Mulley . - -This file is part of GNU Modula-2. - -GNU Modula-2 is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Modula-2 is distributed in the hope that it will be useful, but -WITHOUT 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 -along with GNU Modula-2; see the file COPYING3. If not see -. */ - - -#define _network_C -#include "Gnetwork.h" - -#include "config.h" -#include "system.h" - - -short unsigned int -network_htons (short unsigned int s) -{ - return htons (s); -} - -unsigned int -network_htonl (unsigned int s) -{ - return htonl (s); -}