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.
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.
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)
$(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 $@
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
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 \
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) $@
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
-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 $@
-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) \
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) $@
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.
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
@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
-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
-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=$@ $<
-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=$@ $<
+++ /dev/null
-/* GBuiltins.c dummy module to aid linking mc projects.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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)
-{
-}
+++ /dev/null
-/* RTco.c provides dummy access to thread primitives.
-
-Copyright (C) 2019-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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)
-{
-}
+++ /dev/null
-/* Gdtoa.c provides access to double string conversion.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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
+++ /dev/null
-/* Gerrno.c provides access to errno for Modula-2.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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
+++ /dev/null
-/* Gldtoa.c provides access to long double string conversion.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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
-/* Gtermios.c handwritten module for mc.
+/* Gtermios.cc handwritten module for mc.
Copyright (C) 2010-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<Args__T1> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<void *> (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<int> (libc_write (1, &a, static_cast<size_t> (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<int> (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<int> (libc_write (1, &ch, static_cast<size_t> (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<int> (libc_write (1, &ch, static_cast<size_t> (1)));
- }
- else if (l < 16)
- {
- /* avoid dangling else. */
- ch = ((char) (( ((unsigned int) ('a'))+((unsigned int ) (l)))-10));
- i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (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<int> (libc_write (1, &ch, static_cast<size_t> (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<ConcatContentsAddress__T1> (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<void *> (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<void *> (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<unsigned int> (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<unsigned int> (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<unsigned int> (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<unsigned int> (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<int> (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<int> (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<string__T2> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<GetEnvironment__T1> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<void *> (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<FIO_PtrToChar> (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<FIO__T7 *> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<ReadFromBuffer__T1> (a);
- (*p) = static_cast<unsigned char> ((*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<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
- p = static_cast<ReadFromBuffer__T1> (libc_memcpy (a, t, static_cast<size_t> (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<void *> (reinterpret_cast<char *> (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<int> (libc_read (fd->unixfd, a, static_cast<size_t> ((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<FIO_FileDescriptor> (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<BufferedRead__T3> (a);
- (*p) = static_cast<unsigned char> ((*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<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
- p = static_cast<BufferedRead__T3> (libc_memcpy (a, t, static_cast<size_t> (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<void *> (reinterpret_cast<char *> (a)+n);
- nBytes -= n; /* reduce the amount for future direct */
- /* read */
- total += n;
- }
- }
- else
- {
- /* refill buffer */
- n = static_cast<int> (libc_read (fd->unixfd, fd->buffer->address, static_cast<size_t> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<BufferedWrite__T5> (a);
- (*fd->buffer->contents).array[fd->buffer->position] = static_cast<char> ((*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<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
- p = static_cast<BufferedWrite__T5> (libc_memcpy (a, t, static_cast<size_t> ((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<void *> (reinterpret_cast<char *> (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<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
- if (f == Error)
- {
- fe = static_cast<FIO_FileDescriptor> (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 *) "<stdin>", 7, FIO_successful, FIO_openedforread, FALSE, 0, MaxBufferLength);
- FIO_StdOut = 2;
- PreInitialize (FIO_StdOut, (const char *) "<stdout>", 8, FIO_successful, FIO_openedforwrite, TRUE, 1, MaxBufferLength);
- FIO_StdErr = 3;
- PreInitialize (FIO_StdErr, (const char *) "<stderr>", 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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<size_t> (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<ReadNBytes__T2> (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<char> (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<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
- if (fd != NULL)
- {
- total = static_cast<int> (libc_write (fd->unixfd, src, static_cast<size_t> ((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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<size_t> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<GetFileName__T6> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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 ();
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<unsigned int> ((*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<char> (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<unsigned int> (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<unsigned int> (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<DynamicStrings_String> (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<unsigned int> (width), leader, FALSE, 10, FALSE));
- (*startpos) = afterperc;
- DSdbExit (static_cast<DynamicStrings_String> (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<unsigned int> (width), leader, 16, TRUE));
- (*startpos) = afterperc;
- DSdbExit (static_cast<DynamicStrings_String> (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<unsigned int> (width), leader, 10, FALSE));
- (*startpos) = afterperc;
- DSdbExit (static_cast<DynamicStrings_String> (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<DynamicStrings_String> (NULL));
- return in;
- }
- }
- DSdbExit (static_cast<DynamicStrings_String> (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<unsigned int> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<int> (libc_write (FIO_GetUnixFileDescriptor (f), &ch, static_cast<size_t> (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<int> (libc_read (FIO_GetUnixFileDescriptor (FIO_StdIn), ch, static_cast<size_t> (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[])
-{
-}
+++ /dev/null
-/* 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<size_t> (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<void *> (reinterpret_cast<char *> (b)+oldSize);
- b = libc_memset (b, 0, static_cast<size_t> (i->ArraySize-oldSize));
- }
- i->High = n;
- }
- }
- b = i->ArrayStart;
- b = reinterpret_cast<void *> (reinterpret_cast<char *> (b)+(n-i->Low)*sizeof (void *));
- p = static_cast<PutIndice__T1> (b);
- (*p) = reinterpret_cast<unsigned int *> (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<Indexing_PtrToByte> (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<Indexing_PtrToByte> (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<Indexing_PtrToByte> (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<Indexing_PtrToByte> (i->ArrayStart);
- b += sizeof (void *)*(j-i->Low);
- p = (Indexing_PtrToAddress) (b);
- b += sizeof (void *);
- p = static_cast<Indexing_PtrToAddress> (libc_memmove (reinterpret_cast<void *> (p), reinterpret_cast<void *> (b), static_cast<size_t> ((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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (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<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (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<void *> (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<void *> (modname), modlen, reinterpret_cast<void *> (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<void *> (start), len, reinterpret_cast<void *> (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<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
- libc_write (2, &buffer, static_cast<size_t> (len));
- len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
- libc_write (2, &buffer, static_cast<size_t> (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<M2LINK_PtrToChar> (cstr), reinterpret_cast<M2LINK_PtrToChar> (&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<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
- while ((pc != NULL) && ((*pc) != ASCII_nul))
- {
- if (equal (reinterpret_cast<void *> (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<void *> (pc), (const char *) "module", 6))
- {
- /* avoid dangling else. */
- ModuleTrace = TRUE;
- pc += 6;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
- {
- /* avoid dangling else. */
- WarningTrace = TRUE;
- pc += 7;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
- {
- /* avoid dangling else. */
- HexTrace = TRUE;
- pc += 3;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
- {
- /* avoid dangling else. */
- DependencyTrace = TRUE;
- pc += 3;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "pre", 3))
- {
- /* avoid dangling else. */
- PreTrace = TRUE;
- pc += 3;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "post", 4))
- {
- /* avoid dangling else. */
- PostTrace = TRUE;
- pc += 4;
- }
- else if (equal (reinterpret_cast<void *> (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<M2Dependent_DependencyState>(static_cast<int>(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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<int> (libc_write (stderrFd, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
-}
-
-
-/*
- ErrorStringC - writes a string to stderr.
-*/
-
-static void ErrorStringC (void * str)
-{
- int len;
-
- len = static_cast<int> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<MemCopy__T1> (from);
- pwb = static_cast<MemCopy__T1> (to);
- (*pwb) = (*pwa);
- from = reinterpret_cast<void *> (reinterpret_cast<char *> (from)+sizeof (unsigned int ));
- to = reinterpret_cast<void *> (reinterpret_cast<char *> (to)+sizeof (unsigned int ));
- length -= sizeof (unsigned int );
- }
- while (length > 0)
- {
- pba = static_cast<MemCopy__T2> (from);
- pbb = static_cast<MemCopy__T2> (to);
- (*pbb) = (*pba);
- from = reinterpret_cast<void *> (reinterpret_cast<char *> (from)+sizeof (unsigned char ));
- to = reinterpret_cast<void *> (reinterpret_cast<char *> (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<MemZero__T3> (a);
- while (length >= sizeof (unsigned int ))
- {
- (*pwa) = (unsigned int ) (0);
- pwa += sizeof (unsigned int );
- length -= sizeof (unsigned int );
- }
- pba = static_cast<MemZero__T4> ((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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<int> (i)))) != (DynamicStrings_char (s, static_cast<int> (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<WarnString__T1> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<int> (libc_write (2, &a, static_cast<size_t> (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<RTExceptions_PtrToChar> (s);
- f = static_cast<RTExceptions_PtrToChar> (s);
- while ((*p) != ASCII_nul)
- {
- if ((*p) == '/')
- {
- p += 1;
- f = p;
- }
- else
- {
- p += 1;
- }
- }
- return reinterpret_cast<void *> (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<RTExceptions_PtrToChar> (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<RTExceptions_PtrToChar> (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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
-}
-
-
-/*
- invalidloc - raise an invalid location exception.
-*/
-
-static void invalidloc (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... 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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
-}
-
-
-/*
- wholediv - raise a division by zero exception.
-*/
-
-static void wholediv (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
-}
-
-
-/*
- realvalue - raise an illegal real value exception.
-*/
-
-static void realvalue (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
-}
-
-
-/*
- protection - raise a protection exception.
-*/
-
-static void protection (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
-}
-
-
-/*
- systemf - raise a system exception.
-*/
-
-static void systemf (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
-}
-
-
-/*
- coroutine - raise a coroutine exception.
-*/
-
-static void coroutine (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
-}
-
-
-/*
- exception - raise a exception exception.
-*/
-
-static void exception (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("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<int> (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<M2EXCEPTION_M2Exceptions>(static_cast<int>(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 ();
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<unsigned int> (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<unsigned int> (INT_MAX), 0);
- p = static_cast<unsigned int> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<SArgs_PtrToPtrToChar> ((void *) (((SArgs_PtrToChar) (UnixArgs_GetArgV ()))+(n*sizeof (SArgs_PtrToChar))));
- (*s) = DynamicStrings_InitStringCharStar (reinterpret_cast<void *> ((*ppc)));
- return TRUE;
- }
- else
- {
- (*s) = static_cast<DynamicStrings_String> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<double> (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<DynamicStrings_String> (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<DynamicStrings_String> (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<unsigned int> (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<unsigned int> (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<unsigned int> (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<int> (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<unsigned int> (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<unsigned int> (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<unsigned int> (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<int> (i))))
- {
- /* avoid gcc warning by using compound statement even if not strictly necessary. */
- if ((DynamicStrings_char (s, static_cast<int> (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<int> (i)), '0'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (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<int> (i))))+1))), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (i+1), 0)));
- }
- else
- {
- s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast<int> (i)), ((char) ( ((unsigned int) (DynamicStrings_char (s, static_cast<int> (i))))+1))), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (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<int> (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<int> (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<int> (((unsigned int ) (i)) / base), 0, ' ', FALSE, base, lower))), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (((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<int> (n))) == '-') || ((DynamicStrings_char (s, static_cast<int> (n))) == '+'))
- {
- if ((DynamicStrings_char (s, static_cast<int> (n))) == '-')
- {
- negative = ! negative;
- }
- n += 1;
- }
- while ((n < l) && ((IsDecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValid (DynamicStrings_char (s, static_cast<int> (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<unsigned int> (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<int> (n))) == '+')
- {
- n += 1;
- }
- while ((n < l) && ((IsDecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValid (DynamicStrings_char (s, static_cast<int> (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<long int> (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<long int> (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<int> (n))) == '-') || ((DynamicStrings_char (s, static_cast<int> (n))) == '+'))
- {
- if ((DynamicStrings_char (s, static_cast<int> (n))) == '-')
- {
- negative = ! negative;
- }
- n += 1;
- }
- while ((n < l) && ((IsDecimalDigitValidLong (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValidLong (DynamicStrings_char (s, static_cast<int> (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 unsigned int> (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<int> (n))) == '+')
- {
- n += 1;
- }
- while ((n < l) && ((IsDecimalDigitValidLong (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValidLong (DynamicStrings_char (s, static_cast<int> (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<int> (n))) == '+')
- {
- n += 1;
- }
- while ((n < l) && ((IsDecimalDigitValidShort (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValidShort (DynamicStrings_char (s, static_cast<int> (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<unsigned int> (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<unsigned int> (-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<unsigned int> (((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<unsigned int> (((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<int> (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<int> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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_t> (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 *) "<DEBUG-CALL> %d SysStorage.ALLOCATE (0x%x, %d bytes)\\n", 54, callno, (*a), size);
- libc_printf ((const char *) "<MEM-ALLOC> %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 *) "<DEBUG-CALL> %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_t> (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 *) "<MEM-FREE> %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 *) "<DEBUG-CALL> %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 *) "<MEM-FREE> %ld %d\\n", 19, (*a), size);
- }
- (*a) = libc_realloc ((*a), static_cast<size_t> (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 *) "<MEM-ALLOC> %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 *) "<DEBUG-CALL> %d SysStorage.Available (%d bytes)\\n", 49, callno, size);
- callno += 1;
- }
- a = libc_malloc (static_cast<size_t> (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<void*> (reinterpret_cast<const void*>("M2DEBUG_SYSSTORAGE_trace")))) != NULL;
- }
- else
- {
- trace = FALSE;
- }
- if (enableZero)
- {
- zero = (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<GetTimeString__T1> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<void *> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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 <name of n>"_r".
-*/
-
-static void doRecordNameC (mcPretty_pretty p, decl_node n);
-
-/*
- doPointerNameC - emit the C/C++ pointer type <name of n>*.
-*/
-
-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<decl_node> (libc_memset (reinterpret_cast<void *> (d), 0, static_cast<size_t> (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<decl_node> (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<void *> (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<void *> (d));
- }
- else if (decl_isVar (d))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex ((*decls).variables, reinterpret_cast<void *> (d));
- }
- else if (decl_isType (d))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex ((*decls).types, reinterpret_cast<void *> (d));
- }
- else if (decl_isProcedure (d))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex ((*decls).procedures, reinterpret_cast<void *> (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<void *> (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<decl_node> (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<nameKey_Name> (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<decl_node> (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<void *> (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<void *> (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<void *> (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<void *> (n));
- }
- else
- {
- f = static_cast<decl_node> (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<void *> (n));
- p = getParent (r);
- mcDebug_assert (p->kind == decl_record);
- if (tag != nameKey_NulName)
- {
- symbolKey_putSymKey (p->recordF.localSymbols, tag, reinterpret_cast<void *> (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<void *> (a)));
- mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (b)));
- Indexing_RemoveIndiceFromIndex (i, reinterpret_cast<void *> (a));
- Indexing_RemoveIndiceFromIndex (i, reinterpret_cast<void *> (b));
- Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast<void *> (a));
- Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast<void *> (b));
- mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (a)));
- mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (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<void *> (e));
- }
- else if (decl_isDef (m))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex (m->defF.enumFixup.info, reinterpret_cast<void *> (e));
- }
- else if (decl_isImp (m))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex (m->impF.enumFixup.info, reinterpret_cast<void *> (e));
- }
-}
-
-
-/*
- getNextFixup - return the next fixup from from f.
-*/
-
-static decl_node getNextFixup (decl_fixupInfo *f)
-{
- (*f).count += 1;
- return static_cast<decl_node> (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<void *> (f));
- Indexing_IncludeIndiceIntoIndex (e->enumerationF.listOfSons, reinterpret_cast<void *> (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<decl_node> (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<void *> (e));
- }
- else if (decl_isDef (m))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex (m->defF.constFixup.info, reinterpret_cast<void *> (e));
- }
- else if (decl_isImp (m))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex (m->impF.constFixup.info, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (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<void *> (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<void *> (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<decl_node> (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<unsigned int> (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<unsigned int> (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<decl_node> (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<nameKey_Name> (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<nameKey_Name> (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<nameKey_Name> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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 <name of n>"_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 <name of n>*.
-*/
-
-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<decl_node> (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<decl_node> (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<decl_node> (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<void *> (n))))) && (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n)))))
- {
- mcDebug_assert (! (decl_isVarient (n)));
- mcDebug_assert (! (decl_isVarientField (n)));
- mcDebug_assert (! (decl_isDef (n)));
- alists_includeItemIntoList (todoQ, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (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<decl_node> (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<void *> (n))))
- {
- alists_includeItemIntoList (l, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (Indexing_GetIndice (n->stmtF.statements, 1));
- return hasIfAndNoElse (n);
- }
- else
- {
- /* avoid dangling else. */
- n = static_cast<decl_node> (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<int>(", 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<int>(", 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<void*> (reinterpret_cast<const void*> (", 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<decl_node> (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<decl_node> (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<void*> (reinterpret_cast<const void*>", 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<char *> (", 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<int>(", 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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<void *> (n))))
- {
- return decl_completed;
- }
- else if (alists_isItemInList (l, reinterpret_cast<void *> (n)))
- {
- /* avoid dangling else. */
- return decl_recursive;
- }
- else
- {
- /* avoid dangling else. */
- alists_includeItemIntoList (l, reinterpret_cast<void *> (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<void *> (t)))
- {
- return decl_completed;
- }
- else if (alists_isItemInList (partialQ, reinterpret_cast<void *> (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<void *> (n)))
- {
- db ((const char *) "{T", 2, n);
- outText (doP, (const char *) "}", 1);
- }
- else if (alists_isItemInList (partialQ, reinterpret_cast<void *> (n)))
- {
- /* avoid dangling else. */
- db ((const char *) "{P", 2, n);
- outText (doP, (const char *) "}", 1);
- }
- else if (alists_isItemInList (doneQ, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (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<void *> (n))) || (alists_isItemInList (partialQ, reinterpret_cast<void *> (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<void *> (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<decl_node> (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<void *> (t))) || (alists_isItemInList (doneQ, reinterpret_cast<void *> (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<void *> (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<void *> (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<void *> (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<void *> (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<void *> (t)))
- {
- dbs (decl_partial, n);
- return decl_partial;
- }
- else if (alists_isItemInList (doneQ, reinterpret_cast<void *> (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<decl_node> (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<void *> (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<decl_node> (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<decl_node> (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<decl_node> (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<void *> (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<void *> (n)))))
- {
- alists_includeItemIntoList (v, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (alists_getItemFromList (todoQ, i));
- if (tryComplete (d, c, t, v))
- {
- alists_removeItemFromList (todoQ, reinterpret_cast<void *> (d));
- alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (d));
- i = 1;
- }
- else if (tryPartial (d, pt))
- {
- /* avoid dangling else. */
- alists_removeItemFromList (todoQ, reinterpret_cast<void *> (d));
- alists_includeItemIntoList (partialQ, reinterpret_cast<void *> (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<decl_node> (alists_getItemFromList (partialQ, i));
- if (tryCompleteFromPartial (d, t))
- {
- alists_removeItemFromList (partialQ, reinterpret_cast<void *> (d));
- alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<nameKey_Name> (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<nameKey_Name> (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<decl_node> (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<void *> (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<void *> (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<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
- if (decl_isRecordField (q))
- {
- out1 ((const char *) " <recordfield %s", 16, q);
- }
- else if (decl_isVarientField (q))
- {
- /* avoid dangling else. */
- out1 ((const char *) " <varientfield %s", 17, q);
- }
- else if (decl_isVarient (q))
- {
- /* avoid dangling else. */
- out1 ((const char *) " <varient %s", 12, q);
- }
- else
- {
- /* avoid dangling else. */
- M2RTS_HALT (-1);
- __builtin_unreachable ();
- }
- q = dbgAdd (l, decl_getType (q));
- out1 ((const char *) ": %s>\\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<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
- if (decl_isRecordField (q))
- {
- out1 ((const char *) " <recordfield %s", 16, q);
- }
- else if (decl_isVarientField (q))
- {
- /* avoid dangling else. */
- out1 ((const char *) " <varientfield %s", 17, q);
- }
- else if (decl_isVarient (q))
- {
- /* avoid dangling else. */
- out1 ((const char *) " <varient %s", 12, q);
- }
- else
- {
- /* avoid dangling else. */
- M2RTS_HALT (-1);
- __builtin_unreachable ();
- }
- q = dbgAdd (l, decl_getType (q));
- out1 ((const char *) ": %s>\\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<decl_node> (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<void *> (n));
- i = 1;
- out1 ((const char *) "dbg (%s)\\n", 10, n);
- do {
- n = static_cast<decl_node> (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<decl_node> (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<decl_node> (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<void *> (booleanN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "PROC", 4), reinterpret_cast<void *> (procN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHAR", 4), reinterpret_cast<void *> (charN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CARDINAL", 8), reinterpret_cast<void *> (cardinalN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCARD", 9), reinterpret_cast<void *> (shortcardN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCARD", 8), reinterpret_cast<void *> (longcardN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INTEGER", 7), reinterpret_cast<void *> (integerN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGINT", 7), reinterpret_cast<void *> (longintN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTINT", 8), reinterpret_cast<void *> (shortintN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BITSET", 6), reinterpret_cast<void *> (bitsetN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "REAL", 4), reinterpret_cast<void *> (realN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTREAL", 9), reinterpret_cast<void *> (shortrealN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGREAL", 8), reinterpret_cast<void *> (longrealN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "COMPLEX", 7), reinterpret_cast<void *> (complexN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCOMPLEX", 11), reinterpret_cast<void *> (longcomplexN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12), reinterpret_cast<void *> (shortcomplexN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NIL", 3), reinterpret_cast<void *> (nilN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUE", 4), reinterpret_cast<void *> (trueN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FALSE", 5), reinterpret_cast<void *> (falseN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SIZE", 4), reinterpret_cast<void *> (sizeN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MIN", 3), reinterpret_cast<void *> (minN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MAX", 3), reinterpret_cast<void *> (maxN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FLOAT", 5), reinterpret_cast<void *> (floatN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUNC", 5), reinterpret_cast<void *> (truncN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ORD", 3), reinterpret_cast<void *> (ordN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "VAL", 3), reinterpret_cast<void *> (valN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHR", 3), reinterpret_cast<void *> (chrN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CAP", 3), reinterpret_cast<void *> (capN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ABS", 3), reinterpret_cast<void *> (absN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NEW", 3), reinterpret_cast<void *> (newN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DISPOSE", 7), reinterpret_cast<void *> (disposeN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LENGTH", 6), reinterpret_cast<void *> (lengthN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INC", 3), reinterpret_cast<void *> (incN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DEC", 3), reinterpret_cast<void *> (decN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INCL", 4), reinterpret_cast<void *> (inclN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "EXCL", 4), reinterpret_cast<void *> (exclN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "HIGH", 4), reinterpret_cast<void *> (highN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CMPLX", 5), reinterpret_cast<void *> (cmplxN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "RE", 2), reinterpret_cast<void *> (reN));
- symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "IM", 2), reinterpret_cast<void *> (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<decl_node> (symbolKey_getSymKey (defUniverse, n));
- if (d == NULL)
- {
- d = makeDef (n);
- symbolKey_putSymKey (defUniverse, n, reinterpret_cast<void *> (d));
- Indexing_IncludeIndiceIntoIndex (defUniverseI, reinterpret_cast<void *> (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<decl_node> (symbolKey_getSymKey (modUniverse, n));
- if (m == NULL)
- {
- m = makeImp (n);
- symbolKey_putSymKey (modUniverse, n, reinterpret_cast<void *> (m));
- Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast<void *> (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<decl_node> (symbolKey_getSymKey (modUniverse, n));
- if (m == NULL)
- {
- m = makeModule (n);
- symbolKey_putSymKey (modUniverse, n, reinterpret_cast<void *> (m));
- Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast<void *> (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<decl_node> (symbolKey_getSymKey (scope->defF.decls.symbols, n));
- break;
-
- case decl_module:
- return static_cast<decl_node> (symbolKey_getSymKey (scope->moduleF.decls.symbols, n));
- break;
-
- case decl_imp:
- return static_cast<decl_node> (symbolKey_getSymKey (scope->impF.decls.symbols, n));
- break;
-
- case decl_procedure:
- return static_cast<decl_node> (symbolKey_getSymKey (scope->procedureF.decls.symbols, n));
- break;
-
- case decl_record:
- return static_cast<decl_node> (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<void *> (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<decl_node> (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<void *> (n));
- break;
-
- case decl_varientfield:
- Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast<void *> (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<nameKey_Name> (wlists_getItemFromList (i->identlistF.names, j));
- fj = static_cast<decl_node> (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<void *> (n));
- break;
-
- case decl_imp:
- symbolKey_putSymKey (m->impF.decls.symbols, name, reinterpret_cast<void *> (n));
- break;
-
- case decl_module:
- symbolKey_putSymKey (m->moduleF.decls.symbols, name, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (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<void *> (i));
- }
- else if (decl_isImp (m))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex (m->impF.importedModules, reinterpret_cast<void *> (i));
- }
- else if (decl_isModule (m))
- {
- /* avoid dangling else. */
- Indexing_IncludeIndiceIntoIndex (m->moduleF.importedModules, reinterpret_cast<void *> (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<void *> (n)))
- {
- M2RTS_HALT (-1);
- __builtin_unreachable ();
- }
- else
- {
- Indexing_IncludeIndiceIntoIndex (scopeStack, reinterpret_cast<void *> (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<decl_node> (Indexing_GetIndice (scopeStack, i));
- Indexing_RemoveIndiceFromIndex (scopeStack, reinterpret_cast<void *> (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<void *> (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<void *> (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<void *> (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<void *> (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<void *> (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<void *> (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<void *> (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<void *> (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<void *> (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[])
-{
-}
+++ /dev/null
-/* 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 <safe-ctype.h>\\n", 25);
- }
- else
- {
- mcPretty_print (p, (const char *) "#include <ctype.h>\\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 <stdlib.h>\\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 <limits.h>\\n", 21);
- }
- }
-}
-
-
-/*
- checkFreeMalloc -
-*/
-
-static void checkFreeMalloc (mcPretty_pretty p)
-{
- if (seenFree || seenMalloc)
- {
- checkGccConfigSystem (p);
- if (! (mcOptions_getGccConfigSystem ()))
- {
- mcPretty_print (p, (const char *) "#include <stdlib.h>\\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 <stddef.h>\\n", 21);
- }
- }
-}
-
-
-/*
- checkMemcpy -
-*/
-
-static void checkMemcpy (mcPretty_pretty p)
-{
- if (seenMemcpy || seenStrlen)
- {
- checkGccConfigSystem (p);
- if (! (mcOptions_getGccConfigSystem ()))
- {
- mcPretty_print (p, (const char *) "#include <string.h>\\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 <unistd.h>\\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 <complex.h>\\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 <sys/types.h>\\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<void *> (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<decl_node> (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<DynamicStrings_String> (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<void *> (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<void *> (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<DynamicStrings_String> (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<void *> (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<void *> (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[])
-{
-}
+++ /dev/null
-/* 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<void *> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<int> (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<DynamicStrings_String> (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<DynamicStrings_String> (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<DynamicStrings_String> (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<DynamicStrings_String> (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[])
-{
-}
+++ /dev/null
-/* 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<void *> (decl_lookupDef (decl_getSymName (decl_getMainModule ()))));
- }
- (*p.proc) (reinterpret_cast<void *> (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[])
-{
-}
+++ /dev/null
-/* 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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<outString__T1> (DynamicStrings_string (s));
- newline = TRUE;
- space = FALSE;
- while ((p != NULL) && ((*p) != ASCII_nul))
- {
- if (newline)
- {
- q = static_cast<outString__T1> (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<DynamicStrings_String> (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<DynamicStrings_String> (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<DynamicStrings_String> (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[])
-{
-}
+++ /dev/null
-/* 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<int> (-(DynamicStrings_Length (ext))), 0))))
- {
- return DynamicStrings_Slice (filename, 0, static_cast<int> (-(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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<mcComment_commentDesc> (NULL);
- bodyComment = static_cast<mcComment_commentDesc> (NULL);
- afterComment = static_cast<mcComment_commentDesc> (NULL);
- mcLexBuf_lastcomment = static_cast<mcComment_commentDesc> (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<DynamicStrings_String> (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<void *> (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<mcComment_commentDesc> (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<mcComment_commentDesc> (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<mcComment_commentDesc> (NULL);
- afterComment = static_cast<mcComment_commentDesc> (NULL);
- }
- else if (mcComment_isBodyComment (mcLexBuf_currentcomment))
- {
- /* avoid dangling else. */
- bodyComment = mcLexBuf_currentcomment;
- afterComment = static_cast<mcComment_commentDesc> (NULL);
- }
- else if (mcComment_isAfterComment (mcLexBuf_currentcomment))
- {
- /* avoid dangling else. */
- procedureComment = static_cast<mcComment_commentDesc> (NULL);
- bodyComment = static_cast<mcComment_commentDesc> (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<mcComment_commentDesc> (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<mcComment_commentDesc> (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<DynamicStrings_String> (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<DynamicStrings_String> (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<mcComment_commentDesc> (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<mcComment_commentDesc> (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<mcComment_commentDesc> (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[])
-{
-}
+++ /dev/null
-/* 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<unsigned int> (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<mcError_error> (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<mcError_error> (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<mcError_error> (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<mcError_error> (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<mcError_error> (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[])
-{
-}
+++ /dev/null
-/* 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_ptrToTM> (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 <http://gnu.org/licenses/gpl.html>\\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 <https://www.gnu.org/licenses/>. ", 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 *) "<http://www.gnu.org/licenses/>.", 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 <https://www.gnu.org/licenses/>. ", 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<int> (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<DynamicStrings_String> (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<DynamicStrings_String> (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[])
-{
-}
+++ /dev/null
-/* 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<void *> (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<DynamicStrings_String> (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<void *> (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[])
-{
-}
+++ /dev/null
-/* 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<int> (i))) == '\\')) && ((DynamicStrings_char (s, static_cast<int> (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<int> (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<int> (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[])
-{
-}
+++ /dev/null
-/* 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[])
-{
-}
+++ /dev/null
-/* 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[])
-{
-}
+++ /dev/null
-/* 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[])
-{
-}
+++ /dev/null
-/* 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<DynamicStrings_String> (NULL);
- Mod = static_cast<DynamicStrings_String> (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<DynamicStrings_String> (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[])
-{
-}
+++ /dev/null
-/* 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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<void *> (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<void *> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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 <https://www.gnu.org/licenses/>. */
-
-#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 <identtok> 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<sometok as a change to the ordering of the
- token declarations below would cause this to break. Using ORD() we are
- immune from such changes
- */
- while (! (((( ((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)))))
- {
- 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 <identtok> 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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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 <https://www.gnu.org/licenses/>. */
-
-#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 <identtok> 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<sometok as a change to the ordering of the
- token declarations below would cause this to break. Using ORD() we are
- immune from such changes
- */
- while (! (((( ((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)))))
- {
- 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 <identtok> 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<decl_node> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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 <https://www.gnu.org/licenses/>. */
-
-#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 <identtok> 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<decl_node> (mcStack_push (stk, reinterpret_cast<void *> (n)));
- /* static analysis guarentees a RETURN statement will be used before here. */
- __builtin_unreachable ();
-}
-
-
-/*
- pop -
-*/
-
-static decl_node pop (void)
-{
- return static_cast<decl_node> (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<decl_node> (mcStack_replace (stk, reinterpret_cast<void *> (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<decl_node> (NULL), static_cast<decl_node> (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<sometok as a change to the ordering of the
- token declarations below would cause this to break. Using ORD() we are
- immune from such changes
- */
- while (! (((( ((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)))))
- {
- 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 <identtok> 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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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 <https://www.gnu.org/licenses/>. */
-
-#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 <identtok> 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<decl_node> (mcStack_push (stk, reinterpret_cast<void *> (n)));
- /* static analysis guarentees a RETURN statement will be used before here. */
- __builtin_unreachable ();
-}
-
-
-/*
- pop -
-*/
-
-static decl_node pop (void)
-{
- return static_cast<decl_node> (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<decl_node> (mcStack_replace (stk, reinterpret_cast<void *> (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<decl_node> (NULL), static_cast<decl_node> (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<sometok as a change to the ordering of the
- token declarations below would cause this to break. Using ORD() we are
- immune from such changes
- */
- while (! (((( ((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)))))
- {
- 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 <identtok> 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<decl_node> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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 <https://www.gnu.org/licenses/>. */
-
-#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 <identtok> 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<decl_node> (mcStack_push (stk, reinterpret_cast<void *> (n)));
- /* static analysis guarentees a RETURN statement will be used before here. */
- __builtin_unreachable ();
-}
-
-
-/*
- pop -
-*/
-
-static decl_node pop (void)
-{
- return static_cast<decl_node> (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<decl_node> (mcStack_replace (stk, reinterpret_cast<void *> (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<decl_node> (mcStack_push (withStk, reinterpret_cast<void *> (n)));
-}
-
-
-/*
- endWith -
-*/
-
-static void endWith (void)
-{
- decl_node n;
-
- n = static_cast<decl_node> (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<decl_node> (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<decl_node> (mcStack_push (stmtStk, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (mcStack_push (loopStk, reinterpret_cast<void *> (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<decl_node> (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<decl_node> (NULL), static_cast<decl_node> (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<sometok as a change to the ordering of the
- token declarations below would cause this to break. Using ORD() we are
- immune from such changes
- */
- while (! (((( ((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)))))
- {
- 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 <identtok> 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<decl_node> (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<decl_node> (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<decl_node> (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<decl_node> (NULL);
- hi = static_cast<decl_node> (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<decl_node> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<void *> (n));
- k = lastIndice;
- }
- else
- {
- Storage_DEALLOCATE (reinterpret_cast<void **> (&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_ptrToChar> (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<void **> (&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<unsigned int> (libc_strlen (a));
- Storage_ALLOCATE (reinterpret_cast<void **> (&p), higha+1);
- if (p == NULL)
- {
- M2RTS_HALT (-1); /* out of memory error */
- __builtin_unreachable ();
- }
- else
- {
- n = p;
- pa = static_cast<nameKey_ptrToChar> (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_ptrToChar> (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_ptrToChar> (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_ptrToChar> (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_ptrToChar> (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_ptrToChar> (nameKey_keyToCharStar (key1));
- pj = static_cast<nameKey_ptrToChar> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<arg__T1> (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<size_t> (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<void *> ((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<replace__T2> (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<size_t> (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<start2__T3> (libc_memcpy (v->contents, &a, static_cast<size_t> (_a_high+1)));
- v->arg.array[0].ptr = reinterpret_cast<void *> (p);
- v->arg.array[0].len = _a_high+1;
- p += v->arg.array[0].len;
- p = static_cast<start2__T3> (libc_memcpy (reinterpret_cast<void *> (p), &b, static_cast<size_t> (_b_high+1)));
- v->arg.array[1].ptr = reinterpret_cast<void *> (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<start3__T4> (libc_memcpy (v->contents, &a, static_cast<size_t> (_a_high+1)));
- v->arg.array[0].ptr = reinterpret_cast<void *> (p);
- v->arg.array[0].len = _a_high+1;
- p += v->arg.array[0].len;
- p = static_cast<start3__T4> (libc_memcpy (reinterpret_cast<void *> (p), &b, static_cast<size_t> (_b_high+1)));
- v->arg.array[1].ptr = reinterpret_cast<void *> (p);
- v->arg.array[1].len = _b_high+1;
- p += v->arg.array[1].len;
- p = static_cast<start3__T4> (libc_memcpy (reinterpret_cast<void *> (p), &c, static_cast<size_t> (_c_high+1)));
- v->arg.array[2].ptr = reinterpret_cast<void *> (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<start4__T5> (libc_memcpy (v->contents, &a, static_cast<size_t> (_a_high+1)));
- v->arg.array[0].len = _a_high+1;
- p += v->arg.array[0].len;
- p = static_cast<start4__T5> (libc_memcpy (reinterpret_cast<void *> (p), &b, static_cast<size_t> (_b_high+1)));
- v->arg.array[1].ptr = reinterpret_cast<void *> (p);
- v->arg.array[1].len = _b_high+1;
- p += v->arg.array[1].len;
- p = static_cast<start4__T5> (libc_memcpy (reinterpret_cast<void *> (p), &c, static_cast<size_t> (_c_high+1)));
- v->arg.array[2].ptr = reinterpret_cast<void *> (p);
- v->arg.array[2].len = _c_high+1;
- p += v->arg.array[2].len;
- p = static_cast<start4__T5> (libc_memcpy (reinterpret_cast<void *> (p), &c, static_cast<size_t> (_c_high+1)));
- v->arg.array[3].ptr = reinterpret_cast<void *> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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<unsigned int> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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[])
-{
-}
+++ /dev/null
-/* 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 <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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<Args__T1> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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[])
-{
-}
+++ /dev/null
-/* GBuiltins.c dummy module to aid linking mc projects.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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)
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# if !defined (PROC_D)
-# define PROC_D
- typedef void (*PROC_t) (void);
- typedef struct { PROC_t proc; } PROC;
-# endif
-
-#include <string.h>
-#include <limits.h>
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-#include <stdlib.h>
-# include "GStorage.h"
-#include <unistd.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<void *> (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<int> (libc_write (1, &a, static_cast<size_t> (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<int> (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<int> (libc_write (1, &ch, static_cast<size_t> (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<int> (libc_write (1, &ch, static_cast<size_t> (1)));
- }
- else if (l < 16)
- {
- /* avoid dangling else. */
- ch = ((char) (( ((unsigned int) ('a'))+((unsigned int ) (l)))-10));
- i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (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<int> (libc_write (1, &ch, static_cast<size_t> (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<ConcatContentsAddress__T1> (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<void *> (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<void *> (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<unsigned int> (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<unsigned int> (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<unsigned int> (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<unsigned int> (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<int> (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<int> (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<string__T2> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-#include <stdlib.h>
-# include "GStorage.h"
-# include "Gmcrts.h"
-#include <unistd.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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<void *> (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<FIO_PtrToChar> (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<FIO__T7 *> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<ReadFromBuffer__T1> (a);
- (*p) = static_cast<unsigned char> ((*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<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
- p = static_cast<ReadFromBuffer__T1> (libc_memcpy (a, t, static_cast<size_t> (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<void *> (reinterpret_cast<char *> (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<int> (libc_read (fd->unixfd, a, static_cast<size_t> ((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<FIO_FileDescriptor> (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<BufferedRead__T3> (a);
- (*p) = static_cast<unsigned char> ((*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<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
- p = static_cast<BufferedRead__T3> (libc_memcpy (a, t, static_cast<size_t> (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<void *> (reinterpret_cast<char *> (a)+n);
- nBytes -= n; /* reduce the amount for future direct */
- /* read */
- total += n;
- }
- }
- else
- {
- /* refill buffer */
- n = static_cast<int> (libc_read (fd->unixfd, fd->buffer->address, static_cast<size_t> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<BufferedWrite__T5> (a);
- (*fd->buffer->contents).array[fd->buffer->position] = static_cast<char> ((*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<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
- p = static_cast<BufferedWrite__T5> (libc_memcpy (a, t, static_cast<size_t> ((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<void *> (reinterpret_cast<char *> (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<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
- if (f == Error)
- {
- fe = static_cast<FIO_FileDescriptor> (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 *) "<stdin>", 7, FIO_successful, FIO_openedforread, FALSE, 0, MaxBufferLength);
- FIO_StdOut = 2;
- PreInitialize (FIO_StdOut, (const char *) "<stdout>", 8, FIO_successful, FIO_openedforwrite, TRUE, 1, MaxBufferLength);
- FIO_StdErr = 3;
- PreInitialize (FIO_StdErr, (const char *) "<stderr>", 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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<size_t> (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<ReadNBytes__T2> (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<char> (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<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
- if (fd != NULL)
- {
- total = static_cast<int> (libc_write (fd->unixfd, src, static_cast<size_t> ((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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<size_t> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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<GetFileName__T6> (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<FIO_FileDescriptor> (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<FIO_FileDescriptor> (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 ();
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stdlib.h>
-#include <unistd.h>
-#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<int> (libc_write (FIO_GetUnixFileDescriptor (f), &ch, static_cast<size_t> (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<int> (libc_read (FIO_GetUnixFileDescriptor (FIO_StdIn), ch, static_cast<size_t> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <stdlib.h>
-# 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<size_t> (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<void *> (reinterpret_cast<char *> (b)+oldSize);
- b = libc_memset (b, 0, static_cast<size_t> (i->ArraySize-oldSize));
- }
- i->High = n;
- }
- }
- b = i->ArrayStart;
- b = reinterpret_cast<void *> (reinterpret_cast<char *> (b)+(n-i->Low)*sizeof (void *));
- p = static_cast<PutIndice__T1> (b);
- (*p) = reinterpret_cast<unsigned int *> (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<Indexing_PtrToByte> (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<Indexing_PtrToByte> (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<Indexing_PtrToByte> (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<Indexing_PtrToByte> (i->ArrayStart);
- b += sizeof (void *)*(j-i->Low);
- p = (Indexing_PtrToAddress) (b);
- b += sizeof (void *);
- p = static_cast<Indexing_PtrToAddress> (libc_memmove (reinterpret_cast<void *> (p), reinterpret_cast<void *> (b), static_cast<size_t> ((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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-# 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<unsigned int> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-#include <stdlib.h>
-# include "GStorage.h"
-#include <unistd.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<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (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<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (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<void *> (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<void *> (modname), modlen, reinterpret_cast<void *> (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<void *> (start), len, reinterpret_cast<void *> (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<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
- libc_write (2, &buffer, static_cast<size_t> (len));
- len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
- libc_write (2, &buffer, static_cast<size_t> (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<M2LINK_PtrToChar> (cstr), reinterpret_cast<M2LINK_PtrToChar> (&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<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
- while ((pc != NULL) && ((*pc) != ASCII_nul))
- {
- if (equal (reinterpret_cast<void *> (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<void *> (pc), (const char *) "module", 6))
- {
- /* avoid dangling else. */
- ModuleTrace = TRUE;
- pc += 6;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
- {
- /* avoid dangling else. */
- WarningTrace = TRUE;
- pc += 7;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
- {
- /* avoid dangling else. */
- HexTrace = TRUE;
- pc += 3;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
- {
- /* avoid dangling else. */
- DependencyTrace = TRUE;
- pc += 3;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "pre", 3))
- {
- /* avoid dangling else. */
- PreTrace = TRUE;
- pc += 3;
- }
- else if (equal (reinterpret_cast<void *> (pc), (const char *) "post", 4))
- {
- /* avoid dangling else. */
- PostTrace = TRUE;
- pc += 4;
- }
- else if (equal (reinterpret_cast<void *> (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<M2Dependent_DependencyState>(static_cast<int>(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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# if !defined (PROC_D)
-# define PROC_D
- typedef void (*PROC_t) (void);
- typedef struct { PROC_t proc; } PROC;
-# endif
-
-#include <limits.h>
-# 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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("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[])
-{
-}
+++ /dev/null
-/* GM2LINK.c a handwritten module for mc.
-
-Copyright (C) 2022-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-/* mc currently is built using a static scaffold. */
-
-#include <cstddef>
-
-int M2LINK_StaticInitialization = 1;
-char *M2LINK_ForcedModuleInitOrder = NULL;
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-#include <stdlib.h>
-# include "GStorage.h"
-#include <unistd.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);
-
-/*
- 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<int> (libc_write (stderrFd, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
-}
-
-
-/*
- ErrorStringC - writes a string to stderr.
-*/
-
-static void ErrorStringC (void * str)
-{
- int len;
-
- len = static_cast<int> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-# 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<void *> (n));
- k = LastIndice;
- }
- else
- {
- Storage_DEALLOCATE (reinterpret_cast<void **> (&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_PtrToChar> (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<void **> (&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<unsigned int> (libc_strlen (a));
- Storage_ALLOCATE (reinterpret_cast<void **> (&p), higha+1);
- if (p == NULL)
- {
- M2RTS_HALT (-1); /* out of memory error */
- __builtin_unreachable ();
- }
- else
- {
- n = p;
- pa = static_cast<NameKey_PtrToChar> (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_PtrToChar> (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_PtrToChar> (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_PtrToChar> (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_PtrToChar> (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_PtrToChar> (NameKey_KeyToCharStar (key1));
- pj = static_cast<NameKey_PtrToChar> (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_PtrToChar> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <string.h>
-#include <limits.h>
-#include <stdlib.h>
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-#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 *) "<stdout>", 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<DynamicStrings_String> (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<DynamicStrings_String> (NULL);
- outputFile = FIO_StdOut;
-}
-
-extern "C" void _M2_Output_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-#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<int> (i)))) != (DynamicStrings_char (s, static_cast<int> (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<WarnString__T1> (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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-#include <stdlib.h>
-# include "GStorage.h"
-# include "Gmcrts.h"
-#include <unistd.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<int> (libc_write (2, &a, static_cast<size_t> (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<RTExceptions_PtrToChar> (s);
- f = static_cast<RTExceptions_PtrToChar> (s);
- while ((*p) != ASCII_nul)
- {
- if ((*p) == '/')
- {
- p += 1;
- f = p;
- }
- else
- {
- p += 1;
- }
- }
- return reinterpret_cast<void *> (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<RTExceptions_PtrToChar> (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<RTExceptions_PtrToChar> (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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
-}
-
-
-/*
- invalidloc - raise an invalid location exception.
-*/
-
-static void invalidloc (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... 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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
-}
-
-
-/*
- wholediv - raise a division by zero exception.
-*/
-
-static void wholediv (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
-}
-
-
-/*
- realvalue - raise an illegal real value exception.
-*/
-
-static void realvalue (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("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<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
-}
-
-
-/*
- protection - raise a protection exception.
-*/
-
-static void protection (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
-}
-
-
-/*
- systemf - raise a system exception.
-*/
-
-static void systemf (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
-}
-
-
-/*
- coroutine - raise a coroutine exception.
-*/
-
-static void coroutine (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
-}
-
-
-/*
- exception - raise a exception exception.
-*/
-
-static void exception (void * a)
-{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("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<int> (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<M2EXCEPTION_M2Exceptions>(static_cast<int>(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 ();
-}
+++ /dev/null
-/* RTco.c provides dummy access to thread primitives.
-
-Copyright (C) 2019-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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)
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# if !defined (PROC_D)
-# define PROC_D
- typedef void (*PROC_t) (void);
- typedef struct { PROC_t proc; } PROC;
-# endif
-
-#include <stddef.h>
-#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[])
-{
-}
+++ /dev/null
-/* GSYSTEM.c a handwritten dummy module for mc.
-
-Copyright (C) 2018-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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)
-{
-}
+++ /dev/null
-/* GSelective.c provides access to select for Modula-2.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-/* 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 ()
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# if !defined (PROC_D)
-# define PROC_D
- typedef void (*PROC_t) (void);
- typedef struct { PROC_t proc; } PROC;
-# endif
-
-#include <string.h>
-#include <limits.h>
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <string.h>
-#include <limits.h>
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <string.h>
-#include <limits.h>
-#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[])
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-# 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<unsigned int> (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[])
-{
-}
+++ /dev/null
-/* GSysExceptions.c low level module interfacing exceptions to the OS.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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)
-{
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <stdlib.h>
-#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_t> (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 *) "<DEBUG-CALL> %d SysStorage.ALLOCATE (0x%x, %d bytes)\\n", 54, callno, (*a), size);
- libc_printf ((const char *) "<MEM-ALLOC> %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 *) "<DEBUG-CALL> %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_t> (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 *) "<MEM-FREE> %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 *) "<DEBUG-CALL> %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 *) "<MEM-FREE> %ld %d\\n", 19, (*a), size);
- }
- (*a) = libc_realloc ((*a), static_cast<size_t> (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 *) "<MEM-ALLOC> %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 *) "<DEBUG-CALL> %d SysStorage.Available (%d bytes)\\n", 49, callno, size);
- callno += 1;
- }
- a = libc_malloc (static_cast<size_t> (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<void*> (reinterpret_cast<const void*>("M2DEBUG_SYSSTORAGE_trace")))) != NULL;
- }
- else
- {
- trace = FALSE;
- }
- if (enableZero)
- {
- zero = (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("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[])
-{
-}
+++ /dev/null
-/* Gabort.c a GCC style abort function.
-
-Copyright (C) 2022-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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);
-}
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <string.h>
-#include <limits.h>
-#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[])
-{
-}
+++ /dev/null
-/* Gcbuiltin.c provides access to some math intrinsic functions.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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);
-}
+++ /dev/null
-/* Gdtoa.c provides access to double string conversion.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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
+++ /dev/null
-/* Gerrno.c provides access to errno for Modula-2.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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
+++ /dev/null
-/* Gldtoa.c provides access to long double string conversion.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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
+++ /dev/null
-/* Glibc.c provides access to some libc functions.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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);
-}
+++ /dev/null
-/* Glibm.c provides access to some libm functions.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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);
-}
+++ /dev/null
-/* Gmcrts.c implements case and return exceptions.
-
-Copyright (C) 2016-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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
+++ /dev/null
-/* 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 <gaius.mulley@southwales.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-# 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 <stddef.h>
-#include <string.h>
-#include <limits.h>
-# 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<unsigned int> (0), static_cast<unsigned int> (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<int> (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 *) "<f:", 3, (const char *) ":f>", 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 *) "<t:", 3, (const char *) ":t>", 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 *) "<e:", 3, (const char *) ":e>", 3, e->followinfo);
- }
-}
-
-
-/*
- PrettyCommentStatement -
-*/
-
-static void PrettyCommentStatement (pge_StatementDesc s, unsigned int Left)
-{
- if (s != NULL)
- {
- PrettyCommentExpression (s->expr, Left);
- PrettyFollow ((const char *) "<s:", 3, (const char *) ":s>", 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<unsigned int> (0), static_cast<unsigned int> (0));
- NewLine (3);
- PrettyFollow ((const char *) "<p:", 3, (const char *) ":p>", 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<unsigned int> (((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<unsigned int> (((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<unsigned int> (0), static_cast<unsigned int> (0))) == 1)
- {
- /* only one element */
- WriteGetTokenType ();
- Output_Write ('=');
- EmitSet (to, static_cast<unsigned int> (0), static_cast<unsigned int> (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<unsigned int> (0), static_cast<unsigned int> (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<unsigned int> (0), static_cast<unsigned int> (MaxElementsInSet-1))) > 0))
- {
- Output_WriteString ((const char *) " + SetOfStop", 12);
- Output_Write ('{');
- EmitSet (to, static_cast<unsigned int> (0), static_cast<unsigned int> (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<unsigned int> (0), static_cast<unsigned int> (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<unsigned int> (0), static_cast<unsigned int> (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<unsigned int> (0), static_cast<unsigned int> (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<NameKey_Name> (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<unsigned int> (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<NameKey_Name> (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<unsigned int> (0), static_cast<unsigned int> (0));
- StrIO_WriteLn ();
- StrIO_WriteString ((const char *) " Set 2: ", 36);
- EmitSet (tov, static_cast<unsigned int> (0), static_cast<unsigned int> (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<unsigned int> (0), static_cast<unsigned int> (0));
- NewLine (3);
- StrIO_WriteString ((const char *) "follow: ", 8);
- EmitSet (follow, static_cast<unsigned int> (0), static_cast<unsigned int> (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<pge_SetOfStop> ((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[])
-{
-}
+++ /dev/null
-/* Gwrapc.c wrap libc functions for mc.
-
-Copyright (C) 2005-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-#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 <pwd.h>
-
-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
-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.
+++ /dev/null
-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);
-}
+++ /dev/null
-/* network.c provide access to htons and htonl.
-
-Copyright (C) 2010-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-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
-<http://www.gnu.org/licenses/>. */
-
-
-#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);
-}
projects / thirdparty / gcc.git / commitdiff
